REM  HOL - calculate and write holidays to Psion 3a agenda
REM  Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994 Free Software
REM  Foundation, Inc.
REM  Copyright (C) 1996 Odd Gripenstam
REM
REM  This program is free software; you can redistribute it and/or modify
REM  it under the terms of the GNU General Public License as published by
REM  the Free Software Foundation; either version 2 of the License, or
REM  (at your option) any later version.
REM
REM  This program is distributed in the hope that it will be useful,
REM  but WITHOUT ANY WARRANTY; without even the implied warranty of
REM  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
REM  GNU General Public License for more details.
REM
REM  You should have received a copy of the GNU General Public License
REM  along with this program; if not, write to the Free Software
REM  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.


REM  Magic numbers:
REM    49   size of vectors for loaded holidays
REM    33	characters in alias
REM   -36	end-of-file error
REM     2	size of vectors for simultaneously calculated holidays


REM  Uncomment the following lines to make this into an OPA
rem APP Hol
rem	TYPE $8003
rem	EXT  "HOL"
rem ENDA
	
PROC holmain%:

	REM  Global variables for getting tokens from the rulefile
	GLOBAL 	Grow$(255)		REM the row from the rulefile we are processing
	GLOBAL 	Gtoken$(255)	REM string value of the last read token
	GLOBAl	Gtoken&			REM integer value (if possible) of the token
	GLOBAL	Gtoktyp$(10)	REM type of the last token

	REM  Global variables for calculated dates
	GLOBAL	Gstyle%			REM style-bits for current date
	GLOBAL	Gyrsymb%		REM year view symbol
	GLOBAL	Gdaytxt$(2,254)	REM the text for the day entry
	GLOBAL	Gdaynum&(2)		REM days since 1-JAN-1970 for current date (this is really a UWORD)
	GLOBAL	Gabsdat&(2)		REM the calculated date as days since 31/12/-1 (?)
	GLOBAL	Gdattot%		REM number of used elements in arrays
	GLOBAL	Galias$(32)		REM name of alias for current date
	GLOBAL	Gbool			REM the current value of a boolean value
	GLOBAL	Grepmon%		REM month date repeats on
	GLOBAL	Grepday%		REM day in month / weekday date repeats on
	GLOBAL	Grepnbr%		REM nth weekday date repeats on
	GLOBAL	Greptyp%		REM type of repeat; 1 = can't repeat; 2 = FIX; 3 = FLOAT
							REM i.e. FLOAT(Grepmon%, Grepday%, Grepnbr%)
							REM      FIX(Grepmon%, Grepday%)

	REM  Global variables for loaded holidays
	GLOBAL	Gyrsyma%(49)	REM array of Gyrsymb%
	GLOBAL	Gdaytxa$(49,254)REM array of Gdaytxt$
	GLOBAL	Gstylea%(49)	REM array of Gstyle%
	GLOBAL	Gselcta(49)		REM True if holiday shall be used
	GLOBAL	Gflags%(49)		REM Bit 0 = repeatable
							REM Bit 1 = can't be skipped (sets alias)
	GLOBAL	Gholtot%		REM Number of used elements in arrays
	GLOBAL	Gholidx%		REM Current element in arrays

	REM  Global variables for default values from rule file	
	GLOBAL	Gdstyle%		REM default style
	GLOBAL	Gdyrsym%		REM default year view symbol
	
	REM  Global variables for aliases
	GLOBAL	Galias$(10,33)	REM symbolic names
	GLOBAL	Galias&(10)		REM absolute date
	GLOBAL	Galinxt%		REM index into alias arrays to next free

	REM  Global variables for reading rule file
	GLOBAL  Grulhnd%		REM handle to open file
	GLOBAL 	Grulfil$(128)	REM Name of rule file
	GLOBAL	Growno%			REM row number
	GLOBAL	Gyear%			REM year to create holidays for
	GLOBAL	Gyear1%			REM first year to create holidays for
	GLOBAL	Gyear2%			REM last year to create holidays for

	GLOBAL	Gagnfil$(128)	REM Name of agenda file
	GLOBAL	Grepmod%		REM 1 = Don't write repeating entries
							REM 2 = Write repeating entries if possible
	GLOBAL	Grepsho%		REM 1 = Show all occurrences
							REM 2 = Next only

	REM  Global variables for fonts and screens
	GLOBAL	Gcurfnt%		REM gFONT number of the current font
	GLOBAL	Gscrows%		REM number of text rows on screen with current font
	GLOBAL	Gscrowh%		REM height of one text row
	GLOBAL	Gscrowd%		REM descent of characters in font
	GLOBAL	Gscchrw%		REM max character width
	GLOBAL	Gstatwn%		REM current type of status window
	GLOBAL	Gscheit%		REM screen height
	GLOBAL	Gscwidt%		REM screen width

	REM  Global variables for scrolling
	GLOBAL	Gcurrow%		REM current screen row for cursor

	REM  Global variables for event handling
	GLOBAL	Gevent%(6)		REM events from GETEVENT
	GLOBAL	Gevent			REM true if unhandled events in Gevent

	GLOBAL	Gvers$(8)		REM version number string
	GLOBAL	Gabshow
	GLOBAL	Gcalc			REM really do calculate
	GLOBAL	Gusrmod$(50)	REM current loaded user module

	TRAP CACHE 2000,12000

	Gvers$	 = "V1.0"
	Grulhnd% = 0			REM no file open
	Gholidx% = 0			REM nothing to show on screen
	Gscheit% = gHEIGHT
	Gscwidt% = gWIDTH
	Gyear1%	 = YEAR
	Gyear2%	 = YEAR
	Grepmod% = 2
	Grepsho% = 1			REM Show all
	Gabshow	 = -1			REM show the about window once
	Gcalc	 = -1
	Gusrmod$ = ""

	REM *** SPLIT ***
	REM If you want to translate this file on the Psion, split this
	REM file into two, uncomment the following line and make sure that
	REM the name in quotes is the name you gave the other file.
    rem LOADM "\opo\hol-mod1.opo"

	setfont%:(10)
	setstat:(2)

	REM  Get initial file to open if we seem to be an APP
	IF CMD$(3) = "O" AND CMD$(1) <> CMD$(2)
		rulload%:(CMD$(2))
	ELSE
		REM Show open dialog
		xHUo:
	ENDIF
	
	mainloop:
	
	IF Grulhnd% <> 0
		IOCLOSE(Grulhnd%)
	ENDIF

ENDP

REM =======================================================================================
REM  UI routines
REM =======================================================================================

PROC mainloop:
	REM                          Help  Menu C-Menu Down  Up    PgDn  PgUp  Home  End   Space
	evloop$:("acmnoptuwxz","OZ","|xU291|xU290|xC290|xU257|xU256|xP261|xP260|xP262|xP263|xU032|", -1)
ENDP

REM  Get and process events.
REM  For each event create a cmdcode.
REM
REM  If the event is a hotkey (PSION-<menuchar>) and the <menuchar>
REM  is found in HOTKEYU$ (unshifted keys) or HOTKEYS$ (shifted),
REM  call the cmdcode as a function.
REM
REM  If the event is a system command, call the cmdcode as
REM  a function with the end of the system command as a parameter.
REM
REM  If the cmdcode is found in CMDS$, call the cmdcode as a function.
REM  If the MENU-key was pressed, call the cmdcode (e.g. xU290) with
REM  HOTKEYU$ and HOTKEYS$ as parameters.
REM
REM  If an unknown event is read and IGNORE is true, just ignore the
REM  event, otherwise return the cmdcode.
REM
REM  Continue to read events until a cmdcode-function returns <>0 and
REM  then return "".
PROC evloop$:(hotkeyu$, hotkeys$, cmds$, ignore%)

	LOCAL	done
	LOCAL	k%				REM code for key pressed
	LOCAL	m%				REM code for modifier pressed
	LOCAL	cmdcode$(7)		REM code for command to perform:
							REM x<H,C,S,P,A>...<char,code>
							REM x	 prefix
							REM H	 hotkey (menu-char or equiv. psion-<char>)
							REM C	 control pressed
							REM S	 shift pressed
							REM P	 psion pressed
							REM A	 system command ("argument")
							REM char printable representation of
							REM      key pressed/system command
							REM code decimal key code for nonprintable char
	LOCAL	cmdret			REM return value from cmdcode proc
	LOCAL	c$(127)			REM system command
	LOCAL	k$(3)
	LOCAL	m$(5)
	LOCAL	docall

	Gevent = 0
	done = 0

	WHILE NOT done

		IF NOT Gevent
			GETEVENT Gevent%()
		ENDIF
		
		REM Assume someone will deal with this event
		Gevent = 0
		docall = 0

		IF Gevent%(1) = $404		REM system command
			c$ = GETCMD$
			cmdcode$ = "xA" + MID$(c$, 1, 1)
			docall = -1
			cmdret = @(cmdcode$):(RIGHT$(c$, LEN(c$)-1))
		ELSEIF (Gevent%(1) AND $400) = 0	REM keypress
			k% = Gevent%(1)
			m% = Gevent%(2) AND $00FF
			
			m$ = ""
			IF m% AND 2				REM shift pressed
				m$ = "S"
			ENDIF
			IF m% AND 4				REM control pressed
				m$ = m$ + "C"
			ENDIF
			IF m% AND 8				REM psion pressed
				m$ = m$ + "P"
			ENDIF
			IF m$ = ""				REM unshifted
				m$ = "U"
			ENDIF

			IF k% AND $200			REM Psion hotkey character
				REM ignore other modifiers
				m$ = "H"
				k% = k% - $200
				IF m% AND 2			REM Psion-SHIFT-
					IF LOC(hotkeys$,CHR$(k%))
						docall = -1
						m$ = m$ + "S"
					ENDIF
				ELSE
					IF LOC(hotkeyu$,CHR$(k%))
						docall = -1
						m$ = m$ + "U"
					ENDIF
				ENDIF
			ENDIF
			
			REM is char OK in procedure name?
			IF ((%0 <= k%) AND (k%<=%9)) OR ((%a<=k%) AND (k%<=%z)) OR ((%A<=k%) AND (k%<=%Z))
				k$ = CHR$(k%)
			ELSE
				k$ = RIGHT$("000"+NUM$(k%, 3), 3)
			ENDIF
			cmdcode$ = "x"+m$+k$

			IF LOC(cmds$, "|"+cmdcode$+"|")
				docall = -1
			ENDIF
			
			IF docall
				IF k% = 290			REM special treatment for Menu key
					cmdret = @(cmdcode$):(hotkeyu$, hotkeys$)
				ELSE
					cmdret = @(cmdcode$):
				ENDIF
			ENDIF
		ENDIF

		IF (NOT docall) AND (NOT ignore%)
			RETURN cmdcode$
		ENDIF
		IF docall AND (cmdret <> 0)
			RETURN " "
		ENDIF
	ENDWH
ENDP


REM  Act upon hotkey
PROC evmenu:(hotkeyu$, hotkeys$, k%)

	LOCAL  docall
	LOCAL  m$(4)
	LOCAL  k$(3)
	LOCAL  cmdcode$(10)

	m$ = "H"
	IF k% <= %Z			REM Psion-SHIFT-
		IF LOC(hotkeys$,CHR$(k%))
			docall = -1
			m$ = m$ + "S"
		ENDIF
	ELSE
		IF LOC(hotkeyu$,CHR$(k%))
			docall = -1
			m$ = m$ + "U"
		ENDIF
	ENDIF

	REM is char OK in procedure name?
	IF ((%0 <= k%) AND (k%<=%9)) OR ((%a<=k%) AND (k%<=%z)) OR ((%A<=k%) AND (k%<=%Z))
		k$ = CHR$(k%)
	ELSE
		k$ = RIGHT$("000"+NUM$(k%, 3), 3)
	ENDIF
	cmdcode$ = "x"+m$+k$

	IF docall
		return @(cmdcode$):
	ELSE
		return 0
	ENDIF
ENDP

REM system command exit
PROC xAX:(file$)
	RETURN xHUx:
ENDP

REM system command open
PROC xAO:(file$)
	rulload%:(file$)
ENDP

REM Space - toggle mark
PROC xU032:
	IF Gholidx%<>0
		Gselcta(Gholidx%) = NOT Gselcta(Gholidx%)
		scupdate:(Gcurrow%, Gholidx%, 1, "gshowrow")
	ELSE
		gIPRINT "No holiday file open"
	ENDIF
	RETURN 0
ENDP

REM  Down 
PROC xU257:
	sccurmov:(Gholidx%+1)
	RETURN 0
ENDP

REM  Up
PROC xU256:
	sccurmov:(Gholidx%-1)
	RETURN 0
ENDP

REM  PgDown 
PROC xP261:
	sccurmov:(Gholidx%+Gscrows%-1)
	RETURN 0
ENDP

REM  PgUp
PROC xP260:
	sccurmov:(Gholidx%-Gscrows%+1)
	RETURN 0
ENDP

REM  Home 
PROC xP262:
	sccurmov:(1)
	RETURN 0
ENDP

REM  End
PROC xP263:
	sccurmov:(Gholtot%)
	RETURN 0
ENDP

REM  Menu key pressed
PROC xU290:(hotkeyu$, hotkeys$)

	LOCAL  k%

	LOCK ON
	mINIT
	mCARD "File","Open file",%o,"Close file",%c
	IF Gholidx%<>0
		mCARD "Holidays","Preview",%p,"Write to agenda",-%w,"Toggle mark",%t,"Mark all",%m,"Unmark all",%u,"Mark not repeatable",%n
	ENDIF
	mCARD "Special","Zoom In",%z,"Zoom out",-%Z,"About Hol",%a,"Exit",%x
	k% = MENU
	LOCK OFF

	RETURN evmenu:(hotkeyu$, hotkeys$, k%)
ENDP

PROC xC290:(hotkeyu$, hotkeys$)
	IF Gstatwn% = 1
		setstat:(0)
	ELSEIF Gstatwn% = 2
		setstat:(1)
	ELSE
		setstat:(2)
	ENDIF
	RETURN 0
ENDP

PROC xU291:
	LOCAL helpfil$(12), file$(14), r%
	helpfil$ = "\OPD\HOL.RSC"
	file$ = "M:"+helpfil$
	IF NOT EXIST(file$)
		file$ = "A:"+helpfil$
		IF NOT EXIST(file$)
			file$ = "B:"+helpfil$
			IF NOT EXIST(file$)
				r% = ALERT("Sorry, no help available", "Could not find file "+helpfil$)
				RETURN 0
			ENDIF
		ENDIF
	ENDIF
 	showhelp:(file$)
	RETURN 0
ENDP

PROC xHUa:
	LOCAL	winid%

	winid% = abcre%:
	evloop$:("","","",0)

	IF Gevent%(1) = $404		REM system command
		REM let the main event loop handle this
		Gevent = -1
	ENDIF
	gCLOSE winid%
ENDP

REM  Close current rule file
PROC xHUc:
	rulclos%:
	nofile:
ENDP

REM Select all holidays
PROC xHUm:
	LOCAL	i%
	i% = 1
	IF Gholidx%<>0
		WHILE i%<=Gholtot%
			Gselcta(i%) = -1
			i% = i% + 1
		ENDWH
		scredraw:(1)
	ELSE
		gIPRINT "No holiday file open"
	ENDIF
ENDP

REM Select holidays that can't be written as repeating entries
PROC xHUn:
	LOCAL	i%
	i% = 1
	IF Gholidx%<>0
		WHILE i%<=Gholtot%
			REM bit 0 not set
			IF (Gflags%(i%) AND $1) = 0
				Gselcta(i%) = -1
			ELSE
				Gselcta(i%) = 0
			ENDIF
			i% = i% + 1
		ENDWH
		scredraw:(1)
	ELSE
		gIPRINT "No holiday file open"
	ENDIF
ENDP

REM Open rule file
REM Prompt for a rule file. Open it and read into arrays
REM Save file handle in Grulhnd%
PROC xHUo:

	LOCAL	d%
	LOCAL 	stat%			REM return status
	LOCAL	offset&

	Grulfil$ = "*.hol"

	LOCK ON
	dINIT "Open holiday file"
	dFILE Grulfil$, "File:", 8
	d% = DIALOG
	LOCK OFF

	IF d%
		rulload%:(Grulfil$)
	ELSEIF Gholidx% = 0
		nofile:
	ENDIF

	RETURN 0
ENDP

REM  Preview holidays
PROC xHUp:
	RETURN holdo:("holview",0)
ENDP

REM Toggle mark. Menu option synonymous with space
PROC xHUt:
	RETURN xU032:
ENDP

REM  write holidays
PROC xHUw:
	RETURN holdo:("holwrit",-1)
ENDP

REM De-select all holidays
PROC xHUu:
	LOCAL	i%

	IF Gholidx%<>0
		i% = 1
		WHILE i%<=Gholtot%
			Gselcta(i%) = 0
			i% = i% + 1
		ENDWH
		scredraw:(1)
	ELSE
		gIPRINT "No holiday file open"
	ENDIF
ENDP

PROC xHUx:
	REM  return <> 0 to exit event loop
	RETURN 1
ENDP

REM Zoom in
PROC xHUz:
	RETURN zoom:(1)
ENDP

REM  Zoom out
PROC xHSZ:
	RETURN zoom:(-1)
ENDP



REM =======================================================================================
REM  Misc routines
REM =======================================================================================

PROC abort%:(err%, errmsg$)
	ALERT("Error when "+errmsg$, ERR$(err%), "Abort")
	RETURN err%
ENDP

PROC quit%:(msg1$, msg2$)
	ALERT(msg1$, msg2$, "Quit")
	RETURN -1
ENDP

REM  Create and show the about-window.
REM  Return window id.
PROC abcre%:
	LOCAL	winid%
	LOCAL	oldfont%
	LOCAL	xmargin%, ymargin%
	LOCAL	xmax%, ymax%

	xmargin% = 12	 REM  move out of the border
	ymargin% = 9
	xmax% = 0
	
	REM Create max sized invisible gray window. Resize and move later.
	winid% = gCREATE(0, 0, Gscwidt%, Gscheit%, 0, 1)
	gUSE winid%

	REM Make room for the centered title, write it later when we know the width
	REM double height
	gSTYLE 8
	oldfont% = setfont%:(10)
	gAT xmargin%,Gscrowh%+8

	gSTYLE 1
	setfont%:(9)

	gAT xmargin%,gY+Gscrowh%*1.5
	gPRINT "HOL version ",Gvers$,", Copyright ",CHR$(184)," 1996 Odd Gripenstam"
	xmax% = MAX(xmax%, gX)

	gAT xmargin%,gY+Gscrowh%
	gPRINT "Copyright ",CHR$(184),"1988, 1989, 1990, 1991, 1992, 1993, 1994"
	xmax% = MAX(xmax%, gX)

	gAT xmargin%,gY+Gscrowh%
	gPRINT "Free Software Foundation, Inc."
	xmax% = MAX(xmax%, gX)

	gSTYLE 0
	setfont%:(9)
	gAT xmargin%,gY+Gscrowh%*1.5
	gPRINT "HOL comes with ABSOLUTELY NO WARRANTY. This is free software,"
	xmax% = MAX(xmax%, gX)

	gAT xmargin%,gY+Gscrowh%
	gPRINT "and you are welcome to redistribute it under certain conditions."
	xmax% = MAX(xmax%, gX)

	gAT xmargin%,gY+Gscrowh%
	gPRINT "See the file COPYING.TXT for details."
	xmax% = MAX(xmax%, gX)

	REM  Center the window now that we know how much we used.
	xmax% = xmax% + xmargin%
	ymax% = gY + ymargin%
	gSETWIN (Gscwidt%-xmax%)/2,(Gscheit%-ymax%)/2, xmax%, ymax%

	REM  Write the centered title. Let's assume it will fit in the new width.
	gSTYLE 8
	setfont%:(10)
	gAT xmargin%,Gscrowh%+8
	gPRINTB "About HOL "+Gvers$,gWIDTH,3

	REM 3a 3D-border, extra rounded
	gXBORDER 1, $203

	gVISIBLE ON
	
	gUSE 1
	gSTYLE 0
	setfont%:(oldfont%)
	RETURN winid%
ENDP

PROC agnchek%:(agnhand%)
	LOCAL 	buf$(16), buf%
	LOCAL	stat%

	REM Read the header and check:
	stat% = IOREAD(agnhand%, UADD(ADDR(buf$),1), 16)
	IF stat% < 0
		RETURN abort%:(stat%, "reading ID in "+Gagnfil$)
	ENDIF
	POKEB ADDR(buf$), stat%

	IF buf$<>"AgendaFileType*"+CHR$(0)
		RETURN quit%:("Wrong file label in "+Gagnfil$, buf$)
	ENDIF
	
	stat% = IOREAD(agnhand%, ADDR(buf%), 2)
	IF stat% < 0
		RETURN abort%:(stat%, "reading version in "+Gagnfil$)
	ENDIF

	IF buf%<>$100f
		RETURN quit%:("Wrong file version in "+Gagnfil$, "Found "+HEX$(buf%)+", expected "+HEX$($100f))
	ENDIF
ENDP

PROC agnwrit%:(agnhand%, daynum&, yrsymb%, style%, txt$, reptyp%, repday%, repnbr%, repsho%)
	LOCAL	buf%(8)
	LOCAL	stat%, off&
	LOCAL	daytxt$(254), day%

	daytxt$ = txt$

	REM record type 2, length
	buf%(1) = &2000 + 8 + LEN(daytxt$)

	REM daynum
	buf%(2) = daynum&

	REM slot
	buf%(3) = $FFFF

	REM attributes (low byte), year symbol (high byte)
	IF yrsymb%>32
		REM with year symbol
		buf%(4) = 2 + 4 + 8 + 16
		POKEB UADD(ADDR(buf%()), 7), yrsymb%
	ELSE
		buf%(4) = 2 + 8 + 16
	ENDIF
	
	REM no repeat, then set bit 1
	IF reptyp%=1
		buf%(4) = buf%(4) OR 1
	ENDIF

	REM title style (low byte)
	buf%(5) = style%

	REM find current offset by seeking to the current position
	off& = 0
	stat% = IOSEEK(agnhand%, 3, off&)
	IF stat% < 0
		RETURN abort%:(stat%, "getting offset")
	ENDIF

	stat% = IOWRITE(agnhand%, ADDR(buf%()), 9)
	IF stat% < 0
		RETURN abort%:(stat%, "writing header")
	ENDIF

	REM title text
	stat% = IOWRITE(agnhand%, ADDR(daytxt$), LEN(daytxt$)+1)
	IF stat% < 0
		RETURN abort%:(stat%, "writing text")
	ENDIF

	IF reptyp%=2	REM repeat FIX date as annual repeat
		REM record type 5, length
		buf%(1) = &5000 + 9
		IF repsho%=1
			REM no interval, show all, annual repeat
			buf%(2) = 4
		ELSE
			REM no interval, show next, annual repeat
			buf%(2) = 12
		ENDIF
		REM no ending date
		buf%(3) = $FFFF
		REM associated entry type
		buf%(4) = 2
		REM offset of associated entry
		POKEL UADD(ADDR(buf%()), 7) , off&
		stat% = IOWRITE(agnhand%, ADDR(buf%()), 11)
		IF stat% < 0
			RETURN abort%:(stat%, "writing repeat")
		ENDIF

	ELSEIF reptyp%=3 REM repeat FLOAT date as monthly by day every 12 months
		buf%(4) = 0
		buf%(5) = 0
		buf%(6) = 0
		
		REM record type 5, length
		buf%(1) = &5000 + 14
		IF repsho% = 1
			REM interval 12-1 (B), show all , monthly by days (3)
			buf%(2) = $0B03
		ELSE
			REM interval 12-1 (B), show next (8) , monthly by days (3)
			buf%(2) = $0B0B
		ENDIF
		REM no ending date
		buf%(3) = $FFFF
		REM associated entry type
		buf%(4) = 2

		REM day to repeat on
		IF repday% = 0	REM sunday = bit 6
			day% = 2**6
		ELSE
			day% = 2**(repday%-1)
		ENDIF

		IF repnbr%=-1			REM last days
			POKEB UADD(ADDR(buf%()),11), day%
		ELSE					REM 1st to 4th
			POKEB UADD(ADDR(buf%()),6+repnbr%), day%
		ENDIF

		REM offset of associated entry
		POKEL UADD(ADDR(buf%()),12), off&
		stat% = IOWRITE(agnhand%, ADDR(buf%()), 16)
		IF stat% < 0
			RETURN abort%:(stat%, "writing repeat")
		ENDIF
	ENDIF
	
	RETURN stat%
ENDP

REM  Add an alias to the list.
REM  We have a hard-coded limit of 10 aliases
PROC aliadd%:(name$, value&)
	IF Galinxt%>10
		RETURN quit%:("Too many alias defined", "")
	ENDIF
	Galias$(Galinxt%) = name$
	Galias&(Galinxt%) = value&
	
	Galinxt% = Galinxt%+1
	RETURN 0
ENDP

REM  Return the index into the alias arrays for
REM  the alias name$ or 0 if not found
PROC aliget%:(name$)
	LOCAL	i%
	i% = 1
	WHILE i%<Galinxt%
		IF Galias$(i%)=name$
			RETURN i%
		ENDIF
		i%=i%+1
	ENDWH
	RETURN 0
ENDP

REM  Calculate a date. Return it in Gdaynum& as days since 1970 and in Gabsdat& as days
REM  since 31/12/-1.
REM  Expect '=' { EASTER | FIX(m,d) | HFIX(m,d) | IFIX(m,d) | FLOAT(???) |
REM               DONEIF (...) | '+' <value> | '-' <value>}... ';'
PROC calcdat%:(rulhand%)
	LOCAL	stat%
	LOCAL	i%

	REM skip over the '='
	stat% = expect%:(rulhand%, "CALCDAT", "char", "=")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gdaynum&(1) = 0
	Gabsdat&(1) = 0
	Gdattot% = 1
	Greptyp% = 0

	REM  Calculate date as absolute date
	DO
		stat% = gettok%:(rulhand%)
		IF stat% >= 0
			IF Gtoken$ = "EASTER"
				stat% = opeastr%:(rulhand%)
			ELSEIF Gtoken$ = "FIX"
				stat% = opfix%:(rulhand%)
			ELSEIF Gtoken$ = "HFIX"
				stat% = ophfix%:(rulhand%)
			ELSEIF Gtoken$ = "IFIX"
				stat% = opifix%:(rulhand%)
			ELSEIF Gtoken$ = "FLOAT"
				stat% = opfloat%:(rulhand%)
			ELSEIF Gtoken$ = "LAST"
				stat% = oplast%:(rulhand%)
			ELSEIF Gtoken$ = "DONEIF"
				stat% = opdif%:(rulhand%)
			ELSEIF Gtoken$ = "@"
				stat% = opcall%:(rulhand%)
			ELSEIF Gtoken$ = "+"
				stat% = opadd%:(rulhand%, 1)
			ELSEIF Gtoken$ = "-"
				stat% = opadd%:(rulhand%, -1)
			ELSEIF Gtoken$ = ";"
				REM nothing...
			ELSE
				REM might be an alias
				i% = aliget%:(Gtoken$)
				IF i%>0
					Gabsdat&(1) = Galias&(i%)
				ELSE
					synterr%:("CALCDAT: found unexpected token '"+Gtoken$+"'" )
					RETURN skipto%:(rulhand%, ";", 0)
				ENDIF
			ENDIF
		ENDIF
	UNTIL stat%<0 OR Gtoken$=";"

	REM For all calculated dates
	i% = 1
	WHILE i% <= Gdattot%
		REM Convert to Psion daynum
		IF Gabsdat&(i%) <> 0 AND Gcalc
			Gdaynum&(i%) = dnumabs&:(Gabsdat&(i%))
		ENDIF

		IF Gtoken$=";" AND Gcalc
			Gdaytxt$(i%) = fixtxt$:(Gabsdat&(i%), Gdaytxt$(i%))
		ENDIF
		i% = i% + 1
	ENDWH

	IF Greptyp% = 0
		RETURN quit%:("Greptyp% not set","")
	ENDIF
	
	RETURN stat%
ENDP

REM  Convert date (year, month, day) to daynum
PROC dt2dnm&:(year%, month%, day%)
	RETURN DATETOSECS(year%, month%, day%, 0, 0, 0) / 60/60/24
ENDP

REM  Get the next token. Check that it is of type type$.
REM  If value$ is nonempty, check the token value as well.
REM  Report and return a syntax error if not OK.
PROC expect%:(rulhand%, where$, type$, value$)
	LOCAl	stat%, negative

	negative = 0
	
	stat% = gettok%:(rulhand%)
	IF stat% >= 0

		REM Check for "synthetic tokens" (really syntactic constructs)
		IF type$="negvalue"
			REM Expect {"-"} <value>
			IF Gtoken$="-"
				negative = -1
				REM Get the value
				stat% = gettok%:(rulhand%)
				IF stat%<0
					RETURN stat%
				ENDIF
			ENDIF
			IF Gtoktyp$<>"value"
				RETURN synterr%:(where$+": expected a "+type$+", found "+Gtoktyp$+" '"+Gtoken$+"'")
			ENDIF
			Gtoktyp$ = type$
			IF negative
				Gtoken$ = "-" + Gtoken$
				Gtoken& = -Gtoken&
			ENDIF
		ENDIF
	
		IF Gtoktyp$<>type$
			RETURN synterr%:(where$+": expected a "+type$+", found "+Gtoktyp$+" '"+Gtoken$+"'")
		ENDIF
		IF value$<>"" AND value$<>Gtoken$
			RETURN synterr%:(where$+": expected '" +value$+ "', found '"+Gtoken$+"'")
		ENDIF
	ENDIF
	RETURN stat%
ENDP

PROC expectr%:(rulhand%, where$, type$, low%, high%)
	LOCAL 	stat%

	stat% = expect%:(rulhand%, where$, type$, "")
	IF stat% < 0
		RETURN stat%
	ENDIF
	IF type$="value" OR type$="negvalue"
		IF Gtoken& < INT(low%) OR Gtoken& > INT(high%)
			RETURN synterr%:(where$+": expected a value between " +NUM$(low%,5) +" and "+NUM$(high%,5)+", found "+NUM$(Gtoken&,5))
		ENDIF
	ENDIF
	RETURN stat%
ENDP

REM  Fixup daytext.
REM  	%iy		islamic year, 4 digits
PROC fixtxt$:(absdat&, txt$)
	LOCAL	newtxt$(254), daytxt$(254)
	LOCAL	pos%
	LOCAL	tmp$(8)

	newtxt$ = ""
	daytxt$ = txt$
	pos% = LOC(daytxt$, "%")
	WHILE pos% <> 0
		REM copy text up to %
		newtxt$ = newtxt$ + LEFT$(daytxt$, pos%-1)
		daytxt$ = MID$(daytxt$, pos%, LEN(daytxt$))

		REM substitute %-code with text
		IF LOC(daytxt$, "%iy") = 1
			tmp$ = islabs$:(absdat&)
			newtxt$ = newtxt$ + LEFT$(tmp$, 4)
			daytxt$ = MID$(daytxt$, 4, LEN(daytxt$))
		ELSEIF LOC(daytxt$, "%hy") = 1
			tmp$ = hebabs$:(absdat&)
			newtxt$ = newtxt$ + LEFT$(tmp$, 4)
			daytxt$ = MID$(daytxt$, 4, LEN(daytxt$))
		ENDIF
		pos% = LOC(daytxt$, "%")
	ENDWH
	newtxt$ = newtxt$ + daytxt$
	RETURN newtxt$
ENDP

REM  Get an alias. Returns the alias name in global Galias$
REM  Expect: '=' <symb> ':'
PROC getali%:(rulhand%)

	LOCAL stat%

	REM skip over the '='
	stat% = expect%:(rulhand%, "GETALI", "char", "=")
	IF stat% < 0
		RETURN stat%
	ENDIF

	REM Get the symbol
	stat% = expect%:(rulhand%, "GETALI", "symb", "")
	IF stat% < 0
		RETURN stat%
	ENDIF

	REM  Save the name
	IF LEN(Gtoken$)<=33
		Galias$ = Gtoken$
	ELSE
		RETURN quit%:("Alias too long:", Gtoken$)
	ENDIF

	REM skip over the ';'
	stat% = expect%:(rulhand%, "GETALI", "char", ";")
	IF stat% < 0
		RETURN stat%
	ENDIF

	REM  Check that the name hasn't been used yet
	IF aliget%:(Galias$)<>0
		RETURN synterr%:("GETALI: alias '"+Galias$+"' already defined")
	ENDIF
	
	RETURN stat%
ENDP

REM Get a boolean expression. Return its value in Gbool
REM Expect  'WEEKDAY' '(' day ')' { 'OR' 'WEEKDAY' '(' day ')' } ')'
PROC getbool%:(rulhand%)
	LOCAL	stat%, result, state$(3)

	Gbool = 0
	result = 0
	state$ = ""
	DO
		stat% = gettok%:(rulhand%)
		IF stat% >= 0
			IF Gtoken$ = "WEEKDAY"
				stat% = opwd%:(rulhand%)
				IF state$ = ""
					result = Gbool
				ELSEIF state$ = "OR"
					result = result OR Gbool
				ENDIF
				state$ = ""
				REM don't confuse the ending ) in WEEKDAY with the last
				Gtoken$ = "" 
			ELSEIF Gtoken$ = "OR"
				state$ = "OR"
			ELSEIF Gtoken$ = "@"
				stat% = opcall%:(rulhand%)
			ELSEIF Gtoken$ = ")"
				REM nothing...
			ELSE
				synterr%:("GETBOOL: found unexpected token '"+Gtoken$+"'" )
				RETURN skipto%:(rulhand%, ";", 0)
			ENDIF
		ENDIF
	UNTIL stat%<0 OR Gtoken$=")"

	Gbool = result
	
	RETURN stat%

ENDP

REM  Get and calculate this date. The '{' is already in Gtoken$.
REM  Expect { ['style' '=' <keyword> ';'] | ['year_symbol' '=' <char> ';'] |
REM           ['alias' '=' <symbol> ';']  | <dayname> '=' <calculation> ';' }...
PROC getdate%:(rulhand%)
	LOCAL	stat%, i%
	LOCAL	gotdate

	REM  Init with defaults
	Gstyle%  = Gdstyle%
	Gyrsymb% = Gdyrsym%
	Galias$  = ""
	Gabsdat&(1) = 0
	Gdattot% = 1

	gotdate  = 0
	DO
		stat% = gettok%:(rulhand%)
		IF stat% >= 0
			REM  handle top level tokens: 'style', 'year_symbol', alias, <dayname>
			IF Gtoken$ = "STYLE"
				stat% = getstyl%:(rulhand%)
			ELSEIF Gtoken$ = "YEAR_SYMBOL"
				stat% = getyrsm%:(rulhand%)
			ELSEIF Gtoken$ = "ALIAS"
				stat% = getali%:(rulhand%)
			ELSEIF Gtoken$ = "@"
				stat% = opcall%:(rulhand%)
			ELSEIF Gtoken$ = "}"
				IF NOT gotdate
					RETURN synterr%:("GETDATE: found no date")
				ENDIF
				BREAK
			ELSEIF Gtoktyp$ = "text"
				gotdate = -1

				REM We don't know yet how many dates that will be calculated,
				REM so we will save the text in the whole array
				i% = 1
				WHILE i% <= 2
					Gdaytxt$(i%) = Gtoken$
					i% = i% + 1
				ENDWH
				REM Returns the date in Gabsdat& and Gdaynum&
				stat% = calcdat%:(rulhand%)
			ELSE
				RETURN synterr%:("GETDATE: expected a date, found '"+Gtoken$+"'")
			ENDIF
		ENDIF
	UNTIL stat% < 0

	REM  Save the date if there is an alias
	IF Galias$<>"" AND stat%>=0
		stat% = aliadd%:(Galias$, Gabsdat&(1))
	ENDIF

	RETURN stat%
ENDP

REM  Get next holiday from file rulhand%.
REM  Return end-of-file at end or error.
PROC gethol%:(rulhand%)
	LOCAL	stat%, i%

	REM  Set the default values
	Gyrsymb% = Gdyrsym%
	Gstyle%  = Gdstyle%
	Galias$  = ""
	DO
		stat% = gettok%:(rulhand%)
		IF stat% >= 0
			REM  handle top level tokens: 'style', 'year_symbol', '{', <dayname>
			IF Gtoken$ = "STYLE"
				stat% = getstyl%:(rulhand%)
				Gdstyle% = Gstyle%
			ELSEIF Gtoken$ = "YEAR_SYMBOL"
				stat% = getyrsm%:(rulhand%)
				Gdyrsym% = Gyrsymb%
			ELSEIF Gtoken$ = "@"
				stat% = opcall%:(rulhand%)
			ELSEIF Gtoken$ = "{"
				stat% = getdate%:(rulhand%)
				BREAK
			ELSEIF Gtoktyp$ = "text"
				i% = 1
				WHILE i% <= 2
					Gdaytxt$(i%) = Gtoken$
					i% = i% + 1
				ENDWH
				REM Returns the date in Gabsdat& and Gdaynum&
				stat% = calcdat%:(rulhand%)
				BREAK
			ELSE
				RETURN synterr%:("GETHOL: found unexpected token '"+Gtoken$+"'" )
			ENDIF
		ENDIF
	UNTIL stat% < 0
	
	RETURN stat%
ENDP


REM  Read style(s) into Gstyle%.
REM  The keyword STYLE is already in Gtoken$
REM  Expect '=' {"BOLD"|"ITALIC"|"UNDERLINE|NORMAL"} [","] ... ';'
PROC getstyl%:(rulhand%)

	LOCAL stat%

	REM skip over the '='
	stat% = expect%:(rulhand%, "GETSTYL", "char", "=")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gstyle% = 0
	DO
		REM Get the keyword
		stat% = expect%:(rulhand%, "GETSTYL", "symb", "")
		IF stat% < 0
			RETURN stat%
		ENDIF

		IF Gtoken$="BOLD"
			Gstyle% = Gstyle% OR 1
		ELSEIF Gtoken$="UNDERLINE"
			Gstyle% = Gstyle% OR 2
		ELSEIF Gtoken$="ITALIC"
			Gstyle% = Gstyle% OR 32
		ELSEIF Gtoken$="NORMAL"
			Gstyle% = 0
		ELSE
			RETURN synterr%:("GETSTYL: found '"+Gtoken$+"', expected BOLD,ITALIC,UNDERLINE or NORMAL")
		ENDIF

		REM Get a ',' or ';'
		stat% = gettok%:(rulhand%)
		IF stat% < 0
			RETURN stat%
		ENDIF
		IF Gtoken$<>"," AND Gtoken$<>";"
			RETURN synterr%:("GETSTYL: found '"+Gtoken$+"', expected ',' or ';'")
		ENDIF
	UNTIL Gtoken$=";"
	
	RETURN stat%
ENDP

REM Get a non-comment token
PROC gettok%:(rulhand%)
	LOCAL	stat%
	LOCAL	done

	done = 0
	DO
		stat% = gettok0%:(rulhand%)
		IF stat%<0
			RETURN stat%
		ENDIF

		IF (Gtoktyp$="symb" AND Gtoken$="REM") OR (Gtoktyp$="char" AND Gtoken$="!")
			REM comment; skip rest of line
			stat% = readrow%:(rulhand%)
			IF stat% < 0
				RETURN stat%
			ENDIF
		ELSE
			done = -1
		ENDIF
	UNTIL done
	RETURN stat%
ENDP

REM  Get the next token from the file rulhand%
REM  The token is returned in global variables Gtoktyp$, Gtoken$ and Gtoken&
PROC gettok0%:(rulhand%)

	LOCAL	stat%, c%
	LOCAL	last%
	
	Gtoktyp$ = ""
	Gtoken$  = ""
	Gtoken&  = 0

	REM remove leading blanks and read a new row if necessary
	stat% = skipspc%:(rulhand%)
	IF stat% < 0
		RETURN stat%
	ENDIF

	REM If the first character is a letter, get a symbol
	REM If the first character is a number or '-', get a numeric value
	REM If the first character is a quote, get a text value
	REM Otherwise, get a single character

	c% = ASC(Grow$)
	IF (c%>=%a AND c%<=%z) OR (c%>=%A AND c%<=%Z)
		last%  = 0
		WHILE (c%>=%a AND c%<=%z) OR (c%>=%A AND c%<=%Z) OR (c%>=%0 AND c%<=%9) OR c%=%_
			last% = last% + 1
			c% = ASC(MID$(Grow$, last%+1, 1))
		ENDWH
		Gtoktyp$ = "symb"
		Gtoken$  = UPPER$(LEFT$(Grow$, last%))
		Grow$    = MID$(Grow$, last%+1, LEN(Grow$))
	ELSEIF (c%>=%0 AND c%<= %9)
		last%  = 0
		WHILE (c%>=%0 AND c%<=%9)
			last% = last% + 1
			c% = ASC(MID$(Grow$, last%+1, 1))
		ENDWH
		Gtoktyp$ = "value"
		Gtoken$  = LEFT$(Grow$, last%)
		Gtoken&  = VAL(Gtoken$)
		Grow$    = MID$(Grow$, last%+1, LEN(Grow$))
	ELSEIF c%=ASC("""")
		last%  = 1
		c% = ASC(MID$(Grow$, last%+1, 1))
		WHILE c%<>ASC("""") AND c%<>0
			last% = last% + 1
			c% = ASC(MID$(Grow$, last%+1, 1))
		ENDWH
		IF c%<>ASC("""")
			RETURN synterr%:("GETTOK0: no terminating "" found")
		ENDIF			
		Gtoktyp$ = "text"
		Gtoken$  = MID$(Grow$, 2, last%-1)
		Grow$    = MID$(Grow$, last%+2, LEN(Grow$))
	ELSE
		Gtoktyp$ = "char"
		Gtoken$  = LEFT$(Grow$, 1)
		Grow$    = MID$(Grow$, 2, LEN(Grow$))
	ENDIF

	RETURN stat%
ENDP

REM  Read year symbol into  Gyrsymb%.
REM  The keyword YEAR_SYMBOL is already in Gtoken$
REM  Expect '=' <TEXT> ';'
PROC getyrsm%:(rulhand%)

	LOCAL stat%

	REM skip over the '='
	stat% = expect%:(rulhand%, "GETYRSM", "char", "=")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gyrsymb% = 0
	REM Get the character
	stat% = expect%:(rulhand%, "GETYRSM", "text", "")
	IF stat% < 0
		RETURN stat%
	ENDIF

	IF LEN(Gtoken$)>1
		RETURN synterr%:("GETYRSM: found '"+Gtoken$+"', expected one character")
	ENDIF

	Gyrsymb% = ASC(Gtoken$)

	REM skip over the ';'
	stat% = expect%:(rulhand%, "GETYRSM", "char", ";")
	IF stat% < 0
		RETURN stat%
	ENDIF

	RETURN stat%
ENDP

REM  Move the current position down one character line, scrolling if necessary
REM  Move the position down one font height. If the position + font descent 
REM  then is below the windows lower border then scroll the window up and
REM  move the position up one row.
PROC gNL:
	REM move down one line
	gMOVE -gX,Gscrowh%
	IF gY+Gscrowd%>gHEIGHT
		gSCROLL 0,-Gscrowh%
		gMOVE 0,-Gscrowh%
	ENDIF
ENDP

REM  Get absolute date for hebrew date hday&/hmonth& in the hebrew
REM  year that occurs during gregorian year year&
REM  Dates returned in Gabsdat,Gdattot
PROC hebfix:(hday&, hmonth&, year&)
    LOCAL   hglim$(8)	REM  hebrew date for gregorian 1/1 in year&
    LOCAL   md$(4) 		REM  hmonth&/hday& as numeric string
    LOCAL   hyear&  	REM  hebrew year to use
    LOCAL	abs&

    hglim$ = hebabs$:(absgreg&:(INT(1), INT(1), year&))
    md$ = RIGHT$("00"+NUM$(hmonth&,2), 2) + RIGHT$("00"+NUM$(hday&,2), 2)

    IF md$ >= RIGHT$(hglim$, 4) OR md$ < "0701"
    	hyear& = VAL(LEFT$(hglim$, 4)) 
    ELSE
    	hyear& = VAL(LEFT$(hglim$, 4)) + 1
    ENDIF

	Gdattot% = 1
	Gabsdat&(1) = absheb&:(hday&, hmonth&, hyear&)
ENDP

REM  Apply the selected rule file to a sequence of years.
REM  Prompt for start year, end year.
REM  Prompt for agenda file if AGN is true.
REM  Call FUNC$ for each year.
PROC holdo:(func$, agn%)

	LOCAL	stat%
	LOCAL	d%, dorep%
	LOCAL	year1&, year2&, year%

	year1& = Gyear1%
	year2& = Gyear2%
	dorep% = -1		REM write repeats for first year

	Gagnfil$ = "\agn\*.agn"
	IF Grulhnd% <> 0
		LOCK ON
		REM read the file and put the holidays in the arrays
		IF agn%
			dINIT "Write holidays"
		ELSE
			dINIT "View holidays"
		ENDIF
		dLONG year1&, "Start year", 1980, 2049
		dLONG year2&, "End year", 1980, 2049
		dCHOICE Grepmod%, "Use repeating entries", "No,If possible"
		dCHOICE Grepsho%, "Repeating entry: Show","All occurrences,Next only"
		IF agn%
			dFILE Gagnfil$, "Agenda file:", 8
		ENDIF
		d% = DIALOG
		LOCK OFF
		IF d%
			Gyear1% = year1&
			Gyear2% = year2&

			IF agn%
				LOCK ON
				dINIT 
				dTEXT "","Write to file "+Gagnfil$+"?"
				dBUTTONS "No",%N,"Yes",%Y
				d% = DIALOG
				LOCK OFF
			ELSE
				d% = %y
			ENDIF
			IF d% = %y
				gCLS
	
				year% = Gyear1%
				WHILE year%<=Gyear2% AND (stat%>=0 OR stat%=-36)
					stat% = rulrew:
					IF stat% >= 0
						Gyear% = year%
						stat% = @%(func$):(Grulhnd%, Gyear%, dorep%, Grepsho%)
						year% = year% + 1
						dorep% = 0	REM any repeat only on first year
					ENDIF
				ENDWH
				REM let the user view the result for a while unless there was an error
				IF stat%>=0 OR stat%=-36
					BUSY "Press any key",3
					LOCK ON
					GET
					LOCK OFF
					BUSY OFF
				ENDIF
				scredraw:(1)
			ENDIF
		ENDIF
	ELSE
		gIPRINT "No holiday file open"
	ENDIF
	RETURN 0
ENDP

REM Load the holidays as specified in file rulhand% for year%
PROC holload%:(rulhand%, year%)
	LOCAL	stat%
	LOCAL	i%

	BUSY "Loading..."
	i% = 1
	Gholtot% = 0
	DO
		Gflags%(i%) = 0
		stat% = gethol%:(rulhand%)
		IF stat% >= 0
			IF i% <= 49
				Gholtot% = i%
				Gyrsyma%(i%) = Gyrsymb%
				Gdaytxa$(i%) = Gdaytxt$(1)
				Gstylea%(i%) = Gstyle%
				Gselcta(i%)  = -1
				IF Greptyp%<>1
					Gflags%(i%) = 1
				ENDIF
				IF Galias$<>""
					Gflags%(i%) = Gflags%(i%) OR 2
				ENDIF
				BUSY Gdaytxa$(i%)
				i% = i% + 1
			ELSE
				gIPRINT "Overflow"
			ENDIF
		ENDIF
	UNTIL stat% < 0

	Gholidx% = 1

	BUSY OFF
	RETURN stat%
ENDP

REM View the holidays as specified in file rulhand% for year%
PROC holview%:(rulhand%, year%, dorep%, repsho%)
	LOCAL	stat%
	LOCAL	currow%
	LOCAL	k%, i%, reptyp%

	BUSY "Press key to pause",3
	
	currow% = 0
	DO
		currow% = currow% + 1
		REM If we don't have to calculate and aren't asked to then don't
		IF (Gflags%(currow%) AND $2) = 0 AND NOT Gselcta(currow%)
			Gcalc = 0
			gIPRINT "Skipping. Press key to pause"
		ELSE
			gIPRINT ""
		ENDIF
		stat% = gethol%:(rulhand%)
		Gcalc = -1
		IF stat% >= 0
			i% = 1
			WHILE i% <= Gdattot%
				IF Gselcta(currow%)
					IF Grepmod% = 1			REM If we never write repeating entries...
						reptyp% = 1			REM then force the type to not repeatable
					ELSE
						reptyp% = Greptyp%
					ENDIF
					IF reptyp%=1 OR dorep%<>0
						gshowhol:(Gdaynum&(i%), Gyrsymb%, Gstyle%, Gdaytxt$(i%), reptyp%, Grepmon%, Grepday%, Grepnbr%, repsho%)
					ELSE
						gIPRINT "Skipping. Press key to pause"
					ENDIF
				ENDIF
				i% = i% + 1
			ENDWH
			k% = KEY
			IF k%<>0 AND k%<>27
				BUSY "Press any key",3
				LOCK ON
				GET
				LOCK OFF
				BUSY "Press key to pause",3
			ENDIF
		ENDIF
	UNTIL stat% < 0 OR k%=27 OR currow%=Gholtot%
	
	BUSY OFF
	IF k%=27
		gIPRINT "Cancelled"
		RETURN -1000
	ENDIF

	RETURN stat%
ENDP

REM  Write the holidays as specified in file rulhand% for year%
REM  to agenda file Gagnfil$
PROC holwrit%:(rulhand%, year%, dorep%, repsho%)
	LOCAL	stat%, stat2%
	LOCAL	agnhand%	REM handle for agenda file
	LOCAL	offset&
	LOCAL	currow%
	LOCAL	k%, i%, reptyp%

	REM Open the agenda file and verify that it is an agenda file
	stat% = openagn%:(ADDR(agnhand%), Gagnfil$)
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = agnchek%:(agnhand%)
	IF stat% < 0
		RETURN stat%
	ENDIF

	REM Position to the end of the file
	offset& = 0
	stat% = IOSEEK(agnhand%, 2, offset&)
	IF stat% < 0
		RETURN abort%:(stat%,"seeking end of agenda file")
	ENDIF

	BUSY "Press key to cancel",3
	
	currow% = 0
	DO
		currow% = currow% + 1
		IF (Gflags%(currow%) AND $2) = 0 AND NOT Gselcta(currow%)
			Gcalc = 0
			gIPRINT "Skipping. Press key to pause"
		ELSE
			gIPRINT ""
		ENDIF
		stat% = gethol%:(rulhand%)
		Gcalc = -1
		IF stat% >= 0
			k% = key
			IF Gselcta(currow%) AND k% = 0
				i% = 1
				WHILE i% <= Gdattot% AND stat% >= 0
					IF Grepmod% = 1			REM If we never write repeating entries...
						reptyp% = 1			REM then force the type to not repeatable
					ELSE
						reptyp% = Greptyp%
					ENDIF
					IF reptyp%=1 OR dorep%<>0
						REM can repeat and should repeat
						gshowhol:(Gdaynum&(i%), Gyrsymb%, Gstyle%, Gdaytxt$(i%), reptyp%, Grepmon%, Grepday%, Grepnbr%, repsho%)
						stat% = agnwrit%:(agnhand%, Gdaynum&(i%), Gyrsymb%, Gstyle%, Gdaytxt$(i%), reptyp%, Grepday%, Grepnbr%, repsho%)
					ELSE
						gIPRINT "Skipping. Press key to pause"
					ENDIF
					i% = i% + 1
				ENDWH
			ENDIF
		ENDIF
	UNTIL stat% < 0 OR k% <> 0 OR currow% = Gholtot%

	REM Close the agenda file
	stat2% = IOCLOSE(agnhand%)
	IF stat2% < 0
		RETURN abort%:(stat2%,"closing agenda file")
	ENDIF

	REM return a dummy error if a cancel key was pressed
	IF k%<>0
		RETURN -1000
	ENDIF
	RETURN stat%
ENDP

REM Return true if the first character of txt$ is empty, a space or a tab
PROC isblank:(txt$)
	LOCAL	c%

	c% = ASC(txt$)
	IF c%=0 OR c%=32 OR c%=9
		RETURN -1
	ELSE
		RETURN 0
	ENDIF
ENDP

REM  Get absolute date(s) for islamic date iday&/imonth& in the islamic
REM  year that occurs during gregorian year year&
REM  Dates returned in Gabsdat,Gdattot
PROC islfix:(iday&, imonth&, year&)
    LOCAL   iglim$(8)	REM  islamic date for gregorian 1/1 in year&
    LOCAL   md$(4) 		REM  imonth&/iday& as numeric string
    LOCAL   iyear&  	REM  islamic year to use
    LOCAL	abs&

    iglim$ = islabs$:(absgreg&:(INT(1), INT(1), year&))
    md$ = RIGHT$("00"+NUM$(imonth&,2), 2) + RIGHT$("00"+NUM$(iday&,2), 2)

    IF md$ >= RIGHT$(iglim$, 4) 
    	iyear& = VAL(LEFT$(iglim$, 4))
    ELSE
    	iyear& = VAL(LEFT$(iglim$, 4)) + 1
    ENDIF

	Gabsdat&(1) = absisl&:(iday&, imonth&, iyear&)

	REM Is there a second occurance of this date during year%?
	REM Is it within current gregorian year?
	abs& = absisl&:(iday&, imonth&, INT(iyear&+1))
	IF abs& <= absgreg&:(INT(31), INT(12), year&)
		Gabsdat&(2) = abs&
		Gdattot% = 2
	ENDIF
ENDP

PROC nofile:
	LOCAL	oldfont%
	LOCAL	msg$(15)

	REM double height
	gSTYLE 8
	oldfont% = setfont%:(6)

	msg$ = "No file open"

	gAT Gscwidt%/2-gTWIDTH(msg$),Gscheit%/2+Gscrowh%/2
	gPRINT msg$

	gSTYLE 0
	setfont%:(oldfont%)
ENDP

REM  add next value * factor to Gabsdat&
PROC opadd%:(rulhand%, factor%)
	LOCAL	stat%

	Greptyp% = 1
	
	stat% = expect%:(rulhand%, "OPADD", "value", "")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gabsdat&(1) = Gabsdat&(1) + Gtoken& * factor%
	
	RETURN stat%
ENDP

REM Read [<string>] <token>
PROC opcall%:(rulhand%)
	LOCAL	module$(50)
	LOCAL	proc$(8)
	LOCAL	stat%

	Greptyp% = 1
	
	stat% = gettok%:(rulhand%)
	IF stat% < 0
		RETURN stat%
	ENDIF
	IF Gtoktyp$="text"
		REM Got the optional module name
		module$ = Gtoken$

		IF Gusrmod$<>module$
			IF Gusrmod$<>""
				UNLOADM Gusrmod$
			ENDIF
			LOADM module$
			Gusrmod$ = module$
		ENDIF
		
		stat% = gettok%:(rulhand%)
		IF stat% < 0
			RETURN stat%
		ENDIF
	ENDIF

	IF Gtoktyp$<>"symb"
		RETURN synterr%:("OPCALL: found unexpected token '"+Gtoken$+"'" )
	ENDIF

	proc$ = Gtoken$

	RETURN @%(proc$):(rulhand%)
ENDP

REM Read DONEIF (bool)
REM Expect <bool-expr> ';'
REM If bool is true, skip rest of directive up to ';'
PROC opdif%:(rulhand%)
	LOCAL	stat%

	Greptyp% = 1
	
	stat% = expect%:(rulhand%, "OPDIF", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = getbool%:(rulhand%)
	IF stat% < 0
		RETURN stat%
	ENDIF

	IF Gbool
		stat% = skipto%:(rulhand%, ";", -1)
	ENDIF
	
	RETURN stat%
ENDP

REM  Set date in Gabsdat& for year Gyear%
PROC opeastr%:(rulhand%)
	Greptyp% = 1
	Gdattot% = 1
	IF Gcalc
		Gabsdat&(1) = easter&:(INT(Gyear%))
	ENDIF
	RETURN 0
ENDP

REM  Read FIX(m,d)
REM  Expect '(' <value> ',' <value> ')'
REM  Set date in Gabsdat& for year Gyear%
PROC opfix%:(rulhand%)
	LOCAL	stat%
	LOCAL	month%, day%		REM month in Gyear% and day in month%

	IF Greptyp%<>1
		Greptyp% = 2
	ENDIF

	stat% = expect%:(rulhand%, "OPFIX", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPFIX", "value", 1, 12)
	IF stat% < 0
		RETURN stat%
	ENDIF
	month% = Gtoken&
	Grepmon% = month%

	stat% = expect%:(rulhand%, "OPFIX", "char", ",")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPFIX", "value", 1, 31)
	IF stat% < 0
		RETURN stat%
	ENDIF
	day% = Gtoken&
	Grepday% = day%

	stat% = expect%:(rulhand%, "OPFIX", "char", ")")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gdattot% = 1
	IF Gcalc
		Gabsdat&(1) = absgreg&:(INT(day%), INT(month%), INT(Gyear%))
	ENDIF

	RETURN stat%
ENDP

REM  Read FLOAT(month, dname, n [, day])
REM  Holiday on nth dname (0=Sunday) in month [on or before day/month]
REM
REM  month	is month number
REM  dname 	is weekday (0=Sunday, 1=Monday...)
REM  n 		is nth occurance of dname; <>0. If < 0 then count from end of month
REM  day	if specified, means nth dname on or after/before the DAYth of MONTH
REM
REM  Expect '(' <value> ',' <value> ',' <negvalue> [ ',' <value>] ')'
REM  Set date in Gabsdat& for year Gyear%
PROC opfloat%:(rulhand%)
	LOCAL	stat%
	LOCAL	month&, dname&, n&, day&

	stat% = expect%:(rulhand%, "OPFLOAT", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPFLOAT", "value", 1, 12)
	IF stat% < 0
		RETURN stat%
	ENDIF
	month& = Gtoken&
	Grepmon% = month&

	stat% = expect%:(rulhand%, "OPFLOAT", "char", ",")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPFLOAT", "value", 0, 6)
	IF stat% < 0
		RETURN stat%
	ENDIF
	dname& = Gtoken&
	Grepday% = dname&

	stat% = expect%:(rulhand%, "OPFLOAT", "char", ",")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expect%:(rulhand%, "OPFLOAT", "negvalue", "")
	IF stat% < 0
		RETURN stat%
	ENDIF
	n& = Gtoken&
	Grepnbr% = n&

	REM Get a ',' or ')'
	stat% = gettok%:(rulhand%)
	IF stat% < 0
		RETURN stat%
	ENDIF
	IF Gtoken$<>"," AND Gtoken$<>")"
		RETURN synterr%:("OPFLOAT: found '"+Gtoken$+"', expected ',' or ')'")
	ENDIF

	REM Get day if specified
	day& = 0
	IF Gtoken$=","
		stat% = expectr%:(rulhand%, "OPFLOAT", "value", 1, 31)
		IF stat% < 0
			RETURN stat%
		ENDIF
		day& = Gtoken&
		
		stat% = expect%:(rulhand%, "OPFLOAT", "char", ")")
		IF stat% < 0
			RETURN stat%
		ENDIF
		Greptyp% = 1
	ELSEIF Greptyp%<>1 AND n&>=-1 AND n&<=4 AND n&<>0
		Greptyp% = 3
	ELSE
		Greptyp% = 1
	ENDIF

	Gdattot% = 1
	IF Gcalc
		Gabsdat&(1) = nthabs&:(n&, dname&, month&, INT(Gyear%), day&)
	ENDIF

	RETURN stat%
ENDP

REM  Read HFIX(m,d)
REM  Expect '(' <value> ',' <value> ')'
REM  Set date in Gabsdat& for year Gyear%
PROC ophfix%:(rulhand%)
	LOCAL	stat%
	LOCAL	month%, day%		REM month in Gyear% and day in month%

	Greptyp% = 1

	stat% = expect%:(rulhand%, "OPHFIX", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPHFIX", "value", 1, 13)
	IF stat% < 0
		RETURN stat%
	ENDIF
	month% = Gtoken&

	stat% = expect%:(rulhand%, "OPHFIX", "char", ",")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPHFIX", "value", 1, 30)
	IF stat% < 0
		RETURN stat%
	ENDIF
	day% = Gtoken&

	stat% = expect%:(rulhand%, "OPHFIX", "char", ")")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gdattot% = 1
	IF Gcalc
		hebfix:(INT(day%), INT(month%), INT(Gyear%))
	ENDIF

	RETURN stat%
ENDP

REM  Read IFIX(m,d)
REM  Expect '(' <value> ',' <value> ')'
REM  Set date in Gabsdat& for year Gyear%
PROC opifix%:(rulhand%)
	LOCAL	stat%
	LOCAL	month%, day%		REM month in Gyear% and day in month%

	Greptyp% = 1

	stat% = expect%:(rulhand%, "OPIFIX", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPIFIX", "value", 1, 12)
	IF stat% < 0
		RETURN stat%
	ENDIF
	month% = Gtoken&

	stat% = expect%:(rulhand%, "OPIFIX", "char", ",")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPIFIX", "value", 1, 30)
	IF stat% < 0
		RETURN stat%
	ENDIF
	day% = Gtoken&

	stat% = expect%:(rulhand%, "OPIFIX", "char", ")")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gdattot% = 1
	IF Gcalc
		islfix:(INT(day%), INT(month%), INT(Gyear%))
	ENDIF

	RETURN stat%
ENDP

REM  Read LAST(month)
REM  Expect '(' <value> ')'
REM  Set Gabsdat& to last day of month
PROC oplast%:(rulhand%)
	LOCAL	stat%
	LOCAL	month&

	Greptyp% = 1

	stat% = expect%:(rulhand%, "OPLAST", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPLAST", "value", 1, 12)
	IF stat% < 0
		RETURN stat%
	ENDIF
	month& = Gtoken&

	stat% = expect%:(rulhand%, "OPLAST", "char", ")")
	IF stat% < 0
		RETURN stat%
	ENDIF

	Gdattot% = 1
	IF Gcalc
		Gabsdat&(1) = absgreg&:(ldom&:(month&, INT(Gyear%)), month&, INT(Gyear%))
	ENDIF

	RETURN stat%
ENDP


REM  Read WEEKDAY(day)
REM  Expect '(' <value> ')'
REM  Set Gbool to true if Gabsdat is on weekday day (0 = sunday)
PROC opwd%:(rulhand%)
	LOCAL	stat%
	LOCAL	day%

	stat% = expect%:(rulhand%, "OPWD", "char", "(")
	IF stat% < 0
		RETURN stat%
	ENDIF

	stat% = expectr%:(rulhand%, "OPWD", "value", 0, 6)
	IF stat% < 0
		RETURN stat%
	ENDIF
	day% = Gtoken&

	stat% = expect%:(rulhand%, "OPWD", "char", ")")
	IF stat% < 0
		RETURN stat%
	ENDIF

	IF Gcalc
		Gbool = day% = dow%:(Gabsdat&(1))
	ENDIF

	RETURN stat%
ENDP


REM Open the agenda file as a binary file, positioned to the beginning
PROC openagn%:(pHand%, file$)
	LOCAL stat%
	LOCAL mode%

	REM     existing + binary + update + Random access
	mode% = $0000    + $0000  + $0100  + $0200

	stat% = IOOPEN(#pHand%, file$, mode%)
	IF stat% < 0
		RETURN abort%:(stat%, "opening "+file$)
	ENDIF

	RETURN stat%
ENDP

REM Open the rule file as a text file, positioned to the beginning
PROC openrul%:(pHand%, file$)
	LOCAL stat%
	LOCAL mode%

	REM     existing + text
	mode% = $0000    + $0020

	stat% = IOOPEN(#pHand%, file$, mode%)
	IF stat% < 0
		RETURN abort%:(stat%, "opening "+file$)
	ENDIF
	RETURN stat%
ENDP

REM Read the next row from handle% into global Grow$
PROC readrow%:(handle%)

	LOCAL	stat%

	stat% = IOREAD(handle%, UADD(ADDR(Grow$), 1), 255)
	IF (stat% < 0)
		IF (stat% <> -36)	REM end-of-file
			RETURN abort%:(stat%, "reading rule")
		ENDIF
		RETURN stat%
	ENDIF

	Growno% = Growno% + 1
	
	POKEB ADDR(Grow$),stat%
	RETURN stat%
ENDP

PROC rulclos%:
	LOCAL stat%

	IF Grulhnd%<>0
		stat% = IOCLOSE(Grulhnd%)
		IF stat%<0
			abort%:(stat%, "closing")
		ENDIF
	ENDIF

	SETNAME "Hol"
	Grulhnd% = 0
	Gholidx% = 0
	gCLS
	IF Gusrmod$<>""
		UNLOADM Gusrmod$
	ENDIF

	RETURN 0
ENDP

PROC rulload%:(file$)
	LOCAL	stat%, winid%

	IF Gabshow
		REM show the about-window while we load the file
		winid% = abcre%:
	ENDIF

	Gcalc = 0
	rulclos%:
	
	Grulfil$ = file$
	stat% = openrul%:(ADDR(Grulhnd%), Grulfil$)
	IF stat%>=0
		REM read the file and put the holidays in the arrays
		REM Rewind
		stat% = rulrew:
		IF stat%>=0
			Gyear% = 1996
			stat% = holload%:(Grulhnd%, Gyear%)

			REM Update screen if we read anything
			IF Gholtot%>0
				SETNAME Grulfil$
	
				scupdate:(1, 1, Gscrows%, "gshowrow")
				Gcurrow% = 1
				sccursor:(1)
			ELSE
				rulclos%:
				nofile:
			ENDIF
		ENDIF
	ENDIF
	IF Gabshow
		REM once is enough
		Gabshow = 0
		gCLOSE winid%
	ENDIF
	Gcalc = -1
	
	RETURN stat%
ENDP

REM  Rewind the rule file and prepare globals
PROC rulrew:
	LOCAL 	stat%

	Growno%  = 0
	Grow$    = ""
	Galinxt% = 1
	Gdyrsym% = 0
	Gdstyle% = 0

	REM "Rewind"
	stat% = IOCLOSE(Grulhnd%)
	IF stat% >= 0
		stat% = openrul%:(ADDR(Grulhnd%), Grulfil$)
	ENDIF
	IF stat% < 0
		RETURN abort%:(stat%, "rewinding "+Grulfil$)
	ENDIF
	RETURN stat%
ENDP

REM  Show or hide the cursor at the current text row
PROC sccursor:(onoff%)
	scgorow:(Gcurrow%)
	gSTYLE 0
	IF onoff%=1
		gPRINT CHR$($1c)
	ELSE
		gPRINTB " ",gTWIDTH(CHR$($1c))
	ENDIF
ENDP

REM  Set current screen position to text row rowno% (1-n)
PROC scgorow:(rowno%)
	gAT 0,Gscrowh%*rowno%
ENDP

REM  Move the current index in the arrays to pos idx%
REM  and update the screen accordingly.
PROC sccurmov:(idxp%)
	LOCAL	dist%		REM distance to move
	LOCAL	idx%

	idx% = idxp%
	
	REM anything on screen?
	IF Gholidx% = 0
		RETURN
	ENDIF

	REM Don't move outside the array
	IF idx% < 1
		idx% = 1
	ENDIF
	IF idx% > Gholtot%
		idx% = Gholtot%
	ENDIF

	sccursor:(0)
	dist% = idx% - Gholidx%

	REM Is the destination already on screen?
	IF ((Gcurrow% + dist%) >= 1) AND ((Gcurrow% + dist%) <= Gscrows%)
		REM yes, just move the cursor to that position
		Gcurrow% = Gcurrow% + dist%
		Gholidx% = idx%

	REM Can we scroll the screen into position?
	ELSEIF (dist%=1) AND (Gcurrow%=Gscrows%)
		gSCROLL 0,Gscrowh% * -dist%
		Gholidx% = Gholidx% + dist%
		scupdate:(Gcurrow%, Gholidx%, 1, "gshowrow")

	ELSEIF (dist%=-1) AND (Gcurrow%=1)
		gSCROLL 0,Gscrowh% * -dist%
		Gholidx% = Gholidx% + dist%
		scupdate:(Gcurrow%, Gholidx%, 1, "gshowrow")

	REM Erase and redraw screen
	ELSE
		gUPDATE OFF
		gCLS
		Gholidx% = idx%
		IF dist%<0		REM put new position at top of screen
			Gcurrow% = 1
			scupdate:(1, Gholidx%, Gscrows%, "gshowrow")
		ELSE			REM put new position at end of screen
			Gcurrow% = Gscrows%
			scupdate:(1, Gholidx%-Gscrows%+1, Gscrows%, "gshowrow")
		ENDIF
		gUPDATE ON
	ENDIF
	sccursor:(1)
REM giprint Gdaytxa$(Gholidx%)		
	
ENDP

REM  Redraw the list of holidays
PROC scredraw:(cls%)
	LOCAL	topidx%			REM idx of line on top screen row
	topidx% = Gholidx% - Gcurrow% + 1

	IF cls%<>0
		gCLS
	ENDIF
	scupdate:(1, topidx%, Gscrows%, "gshowrow")
	sccursor:(1)
ENDP

REM  Print some of the lines on the screen
REM  scrow%		first text row to print on
REM  idx%		first array element to print
REM  count%		number of rows to print
REM  prtrow$	name of function to call to print one row
PROC scupdate:(scrow%, idx%, count%, prtrow$)
	LOCAL	idx1%		REM first element
	LOCAL	idx2%		REM last element
	LOCAL	i%
	LOCAL	r%

	REM Get first element to print
	idx1% = idx%
	IF idx% < 1
		idx1% = 1
	ENDIF

	REM Get last element to print
	idx2% = idx% + count% - 1
	IF idx2% > Gholtot%
		idx2% = Gholtot%
	ENDIF

	REM Don't print outside of window
	IF scrow%+count%-1 > Gscrows%
		idx2% = idx1% + (Gscrows% - scrow% + 1)
	ENDIF

	i% = idx1%
	r% = scrow%
	WHILE i% <= idx2%
		scgorow:(r%)
		@(prtrow$):(i%)
		i% = i% + 1
		r% = r% + 1
	ENDWH

ENDP

REM  set current font to number id%. Update globals
PROC setfont%:(id%)
	LOCAL	info%(32)
	LOCAL	oldfont%

	oldfont% = Gcurfnt%
	gFONT(id%)
	Gcurfnt% = id%
	
	gINFO info%()
	Gscrowh% = info%(3)+info%(4)	REM height + descent
	Gscrowd% = info%(4)
	Gscrows% = gHEIGHT / Gscrowh%
	Gscchrw% = info%(7)
	
	RETURN oldfont%
ENDP

PROC setstat:(type%)
	LOCAL	extent%(4)
	
	IF type% = 0
		STATUSWIN OFF
	ELSE
		STATUSWIN ON,type%
	ENDIF
	Gstatwn% = type%
	REM Adjust the main window size
	STATWININFO(-1, extent%())
	gSETWIN 0,0,extent%(1),Gscheit%
	SCREEN 20,15,1,1
	scredraw:(0)
ENDP

PROC gshowhol:(daynum&, yrsymb%, style%, daytxt$, reptyp%, repmon%, repday%, repnbr%, repsho%)
	LOCAL	yr%, mo%, dy%, hr%, mn%, sc%, yrday%
	LOCAL	mo$(2), dy$(2), nbr$(4)

	gNL:
	gSTYLE 0

	SECSTODATE daynum&*24*60*60, yr%, mo%, dy%, hr%, mn%, sc%, yrday%
	mo$ = RIGHT$("00"+NUM$(mo%,2), 2)
	dy$ = RIGHT$("00"+NUM$(dy%,2), 2)
	gPRINT yr%;"-";mo$;"-";dy$

	IF reptyp%<>1
		gAT gTWIDTH("9999-99-99"),gY
		gPRINT CHR$(175)
	ENDIF

	gAT gTWIDTH("9999-99-99M"),gY

	IF yrsymb% >= 32
		gXPRINT CHR$(yrsymb%),1
	ENDIF
	gAT gX+gTWIDTH("MM"),gY
	
	gSTYLE style%
	gPRINT daytxt$

	IF reptyp% <> 1
		gNL:
		gSTYLE 0
		gAT gTWIDTH("9999-99-99MMM"),gY
		IF reptyp%=2
			gPRINT "repeating yearly on ";MONTH$(repmon%);" ";repday%
		ELSEIF reptyp%=3
			dy% = repday%
			IF dy% = 0
				dy% = 7
			ENDIF
			IF repnbr% = 1
				nbr$ = "1st"
			ELSEIF repnbr% = 2
				nbr$ = "2nd"
			ELSEIF repnbr% = 3
				nbr$ = "3rd"
			ELSEIF repnbr% = 4
				nbr$ = "4th"
			ELSE
				nbr$ = "last"
			ENDIF
			gPRINT "repeating yearly on ";nbr$;" ";DAYNAME$(dy%);" in ";MONTH$(repmon%);
		ENDIF
		IF repsho%=1
			gPRINT ", all entries shown"
		ELSE
			gPRINT ", next entry shown"
		ENDIF
	ENDIF
ENDP

PROC gshowrow:(idx%)

	gSTYLE 0

	REM Make room for the cursor
	gAT Gscchrw%,gY

	REM print selection marker
	IF Gselcta(idx%)
		gPRINT "*"
	ELSE
		gPRINTB " ",gTWIDTH("*")
	ENDIF
	gAT Gscchrw%*3,gY
	
	IF Gyrsyma%(idx%) >= 32
		gXPRINT CHR$(Gyrsyma%(idx%)),1
	ENDIF

	gAT 4.5*Gscchrw%,gY
	
	gSTYLE Gstylea%(idx%)
	gPRINT Gdaytxa$(idx%)

	gSTYLE 0
ENDP

PROC showhelp:(fname$)
	LOCAL gate%,buf%(65)
	LOCAL page&,base&
	
	page&=1 :base&=1
	
	REM Convert filename to "C" string:
	POKE$ ADDR(buf%(1)),"#"+fname$
	
	gate%=PEEKW($38)
	SEND(gate%,27,buf%(2)) :REM Set help filename
	SEND(gate%,26,#page&,#base&) :REM Do help
ENDP

REM Move past all blank/tabs in Grow, reading a new line if necessary
PROC skipspc%:(rulhand%)

	LOCAL	stat%

	stat% = 0
	WHILE isblank:(Grow$)
		IF LEN(Grow$) = 0		REM empty string
			stat% = readrow%:(rulhand%)
			IF stat% < 0
				RETURN stat%
			ENDIF
		ELSE
			Grow$ = RIGHT$(Grow$, LEN(Grow$)-1)
		ENDIF
	ENDWH

	RETURN stat%
ENDP

PROC skipto%:(rulhand%, txt$, silent%)
	LOCAL	stat%

	IF NOT silent%
		gIPRINT "Skipping to "+txt$
	ENDIF
	DO
		stat% = gettok%:(rulhand%)
	UNTIL Gtoken$=txt$ OR stat%<0
	RETURN stat%
ENDP

PROC synterr%:(msg$)
	ALERT("Syntax error at line "+GEN$(Growno%, 6), msg$, "OK")
	RETURN -1
ENDP

PROC zoom:(step%):
	LOCAL	topidx%

	REM anything to zoom?
	IF Gholidx%<>0
		Gcurfnt% = Gcurfnt% + step%
		IF Gcurfnt% < 9
			Gcurfnt% = 12
		ENDIF
		IF Gcurfnt% > 12
			Gcurfnt% = 9
		ENDIF
	
		topidx% = Gholidx% - Gcurrow% + 1
		setfont%:(Gcurfnt%)
		IF Gcurrow% > Gscrows%
			topidx% = topidx% + (Gcurrow% - Gscrows%)
			Gcurrow% = Gscrows%
		ENDIF
		gCLS
		scupdate:(1, topidx%, Gscrows%, "gshowrow")
		sccursor:(1)
	ENDIF
	RETURN 0
ENDP

REM =======================================================================================
REM  Special date routines
REM =======================================================================================

PROC mod&:(a&,b&)
	LOCAL r&
    r& = a&-INT(a&/b&)*b&
	RETURN r&
ENDP

PROC mod%:(a%,b%)
	LOCAL r%
    r% = a%-INT(a%/b%)*b%
    RETURN r%
ENDP

REM ===========================================================================
REM
REM  The functions in this section are derived from functions in calendar.el in emacs.
REM  Calendar.el is Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994 Free Software
REM  Foundation, Inc.
REM  Author: Edward M. Reingold <reingold@cs.uiuc.edu>
REM
REM ===========================================================================

REM
REM (defun calendar-leap-year-p (year)
REM   "Returns t if YEAR is a Gregorian leap year."
REM   (or
REM     (and (=  (% year   4) 0)
REM          (/= (% year 100) 0))
REM     (= (% year 400) 0)))
REM 
PROC isleap:(y&)
    RETURN (mod&:(y&,INT(4))=0 AND mod&:(y&,INT(100))<>0) OR (mod&:(y&,INT(400))=0)
ENDP


REM ***************************************************************************
REM (defun calendar-last-day-of-month (month year)
REM   "The last day in MONTH during YEAR."
REM   (if (and (= month 2) (calendar-leap-year-p year))
REM      29
REM    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
REM
PROC ldom&:(m&, y&)
    IF isleap:(y&) AND m&=2
		RETURN 29
    ELSEIF m&=2
		RETURN 28
    ELSEIF m&=1 OR m&=3 OR m&=5 OR m&=7 OR m&=8 OR m&=10 OR m&=12
		RETURN 31
    ELSE
		RETURN 30
    ENDIF
ENDP


REM ****************************************************************************
REM (defun calendar-day-number (date)
REM   "Return the day number within the year of the date DATE.
REM For example, (calendar-day-number '(1 1 1987)) returns the value 1,
REM while (calendar-day-number '(12 31 1980)) returns 366."
REM     (let* ((month (extract-calendar-month date))
REM            (day (extract-calendar-day date))
REM            (year (extract-calendar-year date))
REM          (day-of-year (+ day (* 31 (1- month)))))
REM       (if (> month 2)
REM           (progn
REM             (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
REM             (if (calendar-leap-year-p year)
REM                 (setq day-of-year (1+ day-of-year)))))
REM       day-of-year))
REM 
PROC dnum&:(d&, m&, y&)
    LOCAL doy&	REM day-of-year
	doy& = d& + 31 * (m& - 1)
	IF m&>2
		doy& = doy& - (23 + 4*m&) / 10
		IF isleap:(y&)
			doy& = doy& + 1
		ENDIF
	ENDIF
	RETURN doy&
ENDP


REM ****************************************************************************
REM (defun calendar-absolute-from-gregorian (date)
REM   "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
REM The Gregorian date Sunday, December 31, 1 BC is imaginary."
REM   (let ((prior-years (1- (extract-calendar-year date))))
REM     (+ (calendar-day-number date);; Days this year
REM        (* 365 prior-years);;        + Days in prior years
REM        (/ prior-years 4);;          + Julian leap years
REM        (- (/ prior-years 100));;    - century years
REM        (/ prior-years 400))));;     + Gregorian leap years
REM 
PROC absgreg&:(d&, m&, y&)
	LOCAL	prioryr&	REM prior-years
	LOCAL	a&
REM print "absgreg"
	prioryr& = y& - 1
	a& = dnum&:(d&, m&, y&)		REM days this year
	a& = a& + 365*prioryr&		REM + days in prior years
	a& = a& + prioryr& / 4		REM + Julian leap years
	a& = a& - prioryr& / 100	REM - century years
	a& = a& + prioryr& / 400	REM + Gregorian leap years
	RETURN a&
ENDP


REM ****************************************************************************
REM (defun calendar-gregorian-from-absolute (date)
REM   "Compute the list (month day year) corresponding to the absolute DATE.
REM The absolute date is the number of days elapsed since the (imaginary)
REM Gregorian date Sunday, December 31, 1 BC."
REM ;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
REM ;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
REM ;; Clamen, Software--Practice and Experience, Volume 23, Number 4
REM ;; (April, 1993), pages 383-404 for an explanation.
REM   (let* ((d0 (1- date))
REM          (n400 (/ d0 146097))
REM          (d1 (% d0 146097))
REM          (n100 (/ d1 36524))
REM          (d2 (% d1 36524))
REM          (n4 (/ d2 1461))
REM          (d3 (% d2 1461))
REM          (n1 (/ d3 365))
REM          (day (1+ (% d3 365)))
REM          (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
REM     (if (or (= n100 4) (= n1 4))
REM         (list 12 31 year)
REM       (let ((year (1+ year))
REM             (month 1))
REM         (while (let ((mdays (calendar-last-day-of-month month year)))
REM                  (and (< mdays day)
REM                       (setq day (- day mdays))))
REM           (setq month (1+ month)))
REM         (list month day year)))))
REM

REM  daynum-from-absolute
PROC dnumabs&:(date&)
	LOCAL d0&,n400&,d1&,n100&,d2&,n4&,d3&,n1&,day&,year&
	LOCAL month&, mdays&
	LOCAL y%,m%,d%

REM print "dnumabs:",date&
	d0& 	= date& - 1
	n400&	= d0& / 146097
	d1&		= mod&:(d0&, INT(146097))
	n100&	= d1& / 36524
	d2&		= mod&:(d1&, INT(36524))
	n4&		= d2& / 1461
	d3&		= mod&:(d2&, INT(1461))
	n1&		= d3& / 365
	day&	= 1 + mod&:(d3&, INT(365))
	year&	= 400*n400& + 100*n100& + n4&*4 + n1&

	IF n100&=4 OR n1&=4
		day& = 31
		month& = 12
	ELSE
		year& = year& + 1
		month& = 1
		WHILE 1
			mdays& = ldom&:(month&, year&)	
			IF mdays&<day&
				day& = day& - mdays&
				IF day&<>0
					month& = month&+1
					CONTINUE
				ENDIF
			ENDIF
			BREAK
		ENDWH
	ENDIF

	y% = year& : m% = month& : d% = day&
REM print "y%=";y%
REM print "m%=";m%
REM print "d%=";d%
	RETURN dt2dnm&:(y%, m%, d%)
ENDP
	
REM ****************************************************************************
REM (defun calendar-dayname-on-or-before (dayname date)
REM   "Returns the absolute date of the DAYNAME on or before absolute DATE.
REM DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
REM 
REM Note: Applying this function to d+6 gives us the DAYNAME on or after an
REM absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
REM absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
REM date d, and applying it to d+7 gives the DAYNAME following absolute date d."
REM   (- date (% (- date dayname) 7)))
REM 
PROC doob&:(dayname&, date&)
	LOCAL r&
REM print "doob:",dayname&,date&
	r& = date& - mod&:(date&-dayname&, INT(7))
	RETURN r&
ENDP


REM ****************************************************************************
REM (defun calendar-day-of-week (date)
REM  "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
REM  (% (calendar-absolute-from-gregorian date) 7))
PROC dow%:(absdat&)
	RETURN mod&:(absdat&, INT(7))
ENDP


REM ****************************************************************************
REM (defun calendar-nth-named-absday (n dayname month year &optional day)
REM   "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
REM A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
REM return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
REM If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
REM 
REM If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
REM   (if (> n 0)
REM       (+ (* 7 (1- n))
REM 	     (calendar-dayname-on-or-before
REM 	  		dayname
REM 	  		(+ 6 (calendar-absolute-from-gregorian
REM 					(list month (or day 1) year)))))
REM     (+ (* 7 (1+ n))
REM        (calendar-dayname-on-or-before
REM 		dayname
REM 		(calendar-absolute-from-gregorian
REM 	 	(list month
REM 	       (or day (calendar-last-day-of-month month year))
REM 	       year))))))
REM 
PROC nthabs&:(n&, dayname&, month&, year&, d&)
	LOCAL day&

	day& = d&
	IF n&>0
		IF day& = 0 
			day& = 1
		ENDIF
		RETURN 7*(n&-1)+doob&:(dayname&, 6+absgreg&:(day&, month&, year&))
	ELSE
		IF day& = 0
			day& = ldom&:(month&, year&)
		ENDIF
		RETURN 7*(n&+1)+doob&:(dayname&, absgreg&:(day&, month&, year&))
	ENDIF
ENDP


REM ****************************************************************************
REM (defun calendar-nth-named-day (n dayname month year &optional day)
REM   "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
REM A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
REM return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
REM If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
REM 
REM If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
REM   (calendar-gregorian-from-absolute
REM    (calendar-nth-named-absday n dayname month year day)))
REM 
PROC nthdnum&:(n&, dayname&, month&, year&, d&)
REM print "nthdnum(",n&, dayname&, month&, year&, d&,")"
	RETURN dnumabs&:(nthabs&:(n&, dayname&, month&, year&, d&))
ENDP

REM ****************************************************************************
REM (defun hebrew-calendar-leap-year-p (year)
REM  "t if YEAR is a Hebrew calendar leap year."
REM   (< (% (1+ (* 7 year)) 19) 7))

PROC hclyp:(year&)
	RETURN mod&:(INT((1 + (7*year&))), INT(19)) < 7
ENDP


REM ****************************************************************************
REM (defun hebrew-calendar-elapsed-days (year)
REM   "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
REM   (let* ((months-elapsed
REM           (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
REM              (* 12 (% (1- year) 19))      ;; Regular months in this cycle
REM              (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
REM          (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
REM          (hours-elapsed (+ 5
REM                            (* 12 months-elapsed)
REM                            (* 793 (/ months-elapsed 1080))
REM                            (/ parts-elapsed 1080)))
REM          (parts                                  ;; Conjunction parts
REM           (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
REM          (day                                    ;; Conjunction day
REM           (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
REM          (alternative-day
REM           (if (or (>= parts 19440)    ;; If the new moon is at or after midday,
REM                   (and (= (% day 7) 2);; ...or is on a Tuesday...
REM                        (>= parts 9924)  ;;    at 9 hours, 204 parts or later...
REM                        (not (hebrew-calendar-leap-year-p year)));; of a
REM                                                                 ;; common year,
REM                   (and (= (% day 7) 1);; ...or is on a Monday...
REM                        (>= parts 16789) ;;   at 15 hours, 589 parts or later...
REM                        (hebrew-calendar-leap-year-p (1- year))));; at the end
REM                                                      ;; of a leap year
REM        ;; Then postpone Rosh HaShanah one day
REM              (1+ day)
REM        ;; Else
REM             day)))
REM    (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
REM        (memq (% alternative-day 7) (list 0 3 5))
REM   ;; Then postpone it one (more) day and return        
REM         (1+ alternative-day)
REM   ;; Else return        
REM       alternative-day)))

PROC hced&:(year&)
	LOCAL	monthse&, partse&, hourse&, parts&, day&, altday&, d&

	REM  Months in complete cycles so far.
	monthse& = 235 * INT((year& - 1) / 19)
	REM  Regular months in this cycle
	monthse& = monthse& + 12 * mod&:((year& - 1), INT(19))
	REM  Leap months this cycle
	monthse& = monthse& + ((1 + (7 * mod&:((year& - 1), INT(19)))) / 19)

	partse& = 204 + 793 * mod&:(monthse&, INT(1080))

	hourse& = 5 + 12*monthse& + 793*INT(monthse& / 1080) + INT(partse& / 1080)

	REM  Conjuction parts
	parts& = 1080 * mod&:(hourse&, INT(24)) + mod&:(partse&, INT(1080))

	REM  Conjuction day
	day& = 1 + 29*monthse& + hourse&/24

	IF parts& >= 19440 			REM  If the new moon is at or after midday,
		altday& = day& + 1		REM  Then postpone Rosh HaShanah one day
	ELSEIF mod&:(day&, INT(7))=2 AND parts&>=9924 AND NOT hclyp:(year&)  REM phew
		altday& = day& + 1		REM  Then postpone Rosh HaShanah one day	
	ELSEIF mod&:(day&, INT(7))=1 AND parts&>=16789 AND hclyp:(year& - 1)  REM phew
		altday& = day& + 1		REM  Then postpone Rosh HaShanah one day
	ELSE
		altday& = day&
	ENDIF

	REM  If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
	d& = mod&:(altday&, INT(7))
	IF d&=0 OR d&=3 OR d&=5
		REM  Then postpone it one (more) day and return 
		RETURN altday& + 1
	ENDIF
	RETURN altday&
		
ENDP

REM ****************************************************************************
REM (defun hebrew-calendar-days-in-year (year)
REM   "Number of days in Hebrew YEAR."
REM   (- (hebrew-calendar-elapsed-days (1+ year))
REM      (hebrew-calendar-elapsed-days year)))
PROC hcdiy&:(year&)
	RETURN hced&:(year&+1) - hced&:(year&)
ENDP

REM ****************************************************************************
REM (defun hebrew-calendar-short-kislev-p (year)
REM   "t if Kislev is short in Hebrew YEAR."
REM   (= (% (hebrew-calendar-days-in-year year) 10) 3))
PROC hcskp:(year&)
	RETURN mod&:(hcdiy&:(year&), INT(10)) = 3
ENDP

REM ***************************************************************************
REM (defun hebrew-calendar-long-heshvan-p (year)
REM   "t if Heshvan is long in Hebrew YEAR."
REM   (= (% (hebrew-calendar-days-in-year year) 10) 5))
PROC hclhp:(year&)
	RETURN mod&:(hcdiy&:(year&), INT(10)) = 5
ENDP

REM ***************************************************************************
REM (defun hebrew-calendar-last-day-of-month (month year)
REM   "The last day of MONTH in YEAR."
REM   (if (or (memq month (list 2 4 6 10 13))
REM           (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
REM           (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
REM           (and (= month 9) (hebrew-calendar-short-kislev-p year)))
REM       29
REM     30))
PROC hcldom&:(month&, year&)
	IF month&=2 OR month&=4 OR month&=6 OR month&=10 OR month&=13
		RETURN 29
	ELSEIF month&=12 AND NOT hclyp:(year&)
		RETURN 29
	ELSEIF month&=8 AND NOT hclhp:(year&)
		RETURN 29
	ELSEIF month&=9 AND hcskp:(year&)
		RETURN 29
	ELSE
		RETURN 30
	ENDIF
ENDP

REM ***************************************************************************
REM (defun hebrew-calendar-last-month-of-year (year)
REM   "The last month of the Hebrew calendar YEAR."
REM   (if (hebrew-calendar-leap-year-p year)
REM       13
REM     12))
PROC hclmoy&:(year&)
	IF hclyp:(year&)
		RETURN 13
	ENDIF
	RETURN 12
ENDP

REM ***************************************************************************
REM (defmacro calendar-sum (index initial condition expression)
REM  "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
REM  (` (let (( (, index) (, initial))
REM             (sum 0))
REM       (while (, condition)
REM         (setq sum (+ sum (, expression) ))
REM         (setq (, index) (1+ (, index))))
REM       sum)))
REM 
REM index = initial
REM sum = 0
REM WHILE condition
REM 	sum = sum + expression
REM 	index = index + 1
REM ENDW
REM RETURN sum



REM ****************************************************************************
REM (defun calendar-absolute-from-hebrew (date)
REM   "Absolute date of Hebrew DATE.
REM The absolute date is the number of days elapsed since the (imaginary)
REM Gregorian date Sunday, December 31, 1 BC."
REM   (let* ((month (extract-calendar-month date))
REM          (day (extract-calendar-day date))
REM          (year (extract-calendar-year date)))
REM     (+ day                            ;; Days so far this month.
REM        (if (< month 7);; before Tishri
REM      ;; Then add days in prior months this year before and after Nisan
REM            (+ (calendar-sum
REM                m 7 (<= m (hebrew-calendar-last-month-of-year year))
REM                (hebrew-calendar-last-day-of-month m year))
REM               (calendar-sum
REM                m 1 (< m month)
REM                (hebrew-calendar-last-day-of-month m year)))
REM      ;; Else add days in prior months this year
REM          (calendar-sum
REM           m 7 (< m month)
REM           (hebrew-calendar-last-day-of-month m year)))
REM     (hebrew-calendar-elapsed-days year);; Days in prior years.
REM     -1373429)))                        ;; Days elapsed before absolute date 1.
REM
PROC absheb&:(day&, month&, year&)
	LOCAL	a&, sum&, m&

	a& = day&		REM  Days so far this month.
	IF month&<7		REM  before Tishri
					REM  Then add days in prior months this year before and after Nisan
		m& = 7
		sum& = 0
		WHILE m&<=hclmoy&:(year&)
 			sum& = sum& + hcldom&:(m&, year&)
 			m& = m& + 1
 		ENDWH
		a& = a& + sum&

		m& = 1
		sum& = 0
		WHILE m&<month&
 			sum& = sum& + hcldom&:(m&, year&)
 			m& = m& + 1
 		ENDWH
		a& = a& + sum&
	ELSE			REM  Else add days in prior months this year
		m& = 7
		sum& = 0
		WHILE m&<month&
 			sum& = sum& + hcldom&:(m&, year&)
 			m& = m& + 1
 		ENDWH
		a& = a& + sum&
	ENDIF

	a& = a& + hced&:(year&)	REM  Days in prior years.
	a& = a& - 1373429		REM  Days elapsed before absolute date 1.
	RETURN a&
ENDP


REM ***************************************************************************
REM (defun calendar-hebrew-from-absolute (date)
REM   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
REM The absolute date is the number of days elapsed since the (imaginary)
REM Gregorian date Sunday, December 31, 1 BC."
REM   (let* ((greg-date (calendar-gregorian-from-absolute date))
REM          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
REM                  (1- (extract-calendar-month greg-date))))
REM          (day)
REM          (year (+ 3760 (extract-calendar-year greg-date))))
REM     (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
REM         (setq year (1+ year)))
REM     (let ((length (hebrew-calendar-last-month-of-year year)))
REM       (while (> date
REM                 (calendar-absolute-from-hebrew
REM                  (list month
REM                        (hebrew-calendar-last-day-of-month month year)
REM                        year)))
REM         (setq month (1+ (% month length)))))
REM     (setq day (1+
REM                (- date (calendar-absolute-from-hebrew (list month 1 year)))))
REM     (list month day year)))
PROC hebabs$:(date&)
	LOCAL	month&, day&, year&, length&
	LOCAL	yr%, mo%, dy%, hr%, mn%, sc%, yrday%
	LOCAL	mo$(2), dy$(2), heb$(8)

	REM Get month and year from the absolute date
	SECSTODATE dnumabs&:(date&)*24*60*60, yr%, mo%, dy%, hr%, mn%, sc%, yrday%
	IF mo% = 1
		month& = 9
	ELSEIF mo% = 2
		month& = 10
	ELSEIF mo% = 3
		month& = 11
	ELSEIF mo% = 4
		month& = 12
	ELSEIF mo% = 5
		month& = 1
	ELSEIF mo% = 6
		month& = 2
	ELSEIF mo% = 7
		month& = 3
	ELSEIF mo% = 8
		month& = 4
	ELSEIF mo% = 9 OR mo% = 10 OR mo% = 11
		month& = 7
	ELSE
		month& = 8
	ENDIF

	year& = yr% + 3760
	while date& >= absheb&:(INT(1), INT(7), INT(year&+1))
		year& = year& + 1
	ENDWH
	length& = hclmoy&:(year&)
	WHILE date& > absheb&:(hcldom&:(month&, year&), month&, year&)
		month& = mod&:(month&, length&) + 1
	ENDWH
	day& = 1 + date& - absheb&:(INT(1), month&, year&)
    heb$ = NUM$(year&, 4) + RIGHT$("00"+NUM$(month&, 2), 2)
    heb$ = heb$ + RIGHT$("00"+NUM$(day&, 2), 2)

	RETURN heb$
ENDP
REM ***************************************************************************
REM (defun islamic-calendar-day-number (date)
REM   "Return the day number within the year of the Islamic date DATE."
REM     (let* ((month (extract-calendar-month date))
REM            (day (extract-calendar-day date)))
REM       (+ (* 30 (/ month 2))
REM          (* 29 (/ (1- month) 2))
REM          day)))

PROC icdn&:(day&, month&)
	RETURN 30*INT(month&/2) + 29*INT((month&-1)/2) + day&
ENDP

REM ***************************************************************************
REM (defun calendar-absolute-from-islamic (date)
REM   "Absolute date of Islamic DATE.
REM The absolute date is the number of days elapsed since the (imaginary)
REM Gregorian date Sunday, December 31, 1 BC."
REM   (let* ((month (extract-calendar-month date))
REM          (day (extract-calendar-day date))
REM          (year (extract-calendar-year date))
REM          (y (% year 30))
REM          (leap-years-in-cycle
REM           (cond
REM            ((< y 3) 0)  ((< y 6) 1)  ((< y 8) 2)  ((< y 11) 3) ((< y 14) 4)
REM            ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9)
REM            (t 10))))
REM     (+ (islamic-calendar-day-number date);; days so far this year
REM        (* (1- year) 354)                 ;; days in all non-leap years
REM        (* 11 (/ year 30))                ;; leap days in complete cycles
REM        leap-years-in-cycle               ;; leap days this cycle
REM        227014)))                         ;; days before start of calendar
PROC absisl&:(day&, month&, year&)
	LOCAL	y&
	LOCAL	lyic&	REM leap-years-in-cycle
	LOCAL	a&

	y& = mod&:(year&, INT(30))
	IF y& < 3
		lyic& = 0
	ELSEIF y& < 6
		lyic& = 1
	ELSEIF y& < 8
		lyic& = 2
	ELSEIF y& < 11
		lyic& = 3
	ELSEIF y& < 14
		lyic& = 4
	ELSEIF y& < 17
		lyic& = 5
	ELSEIF y& < 19
		lyic& = 6
	ELSEIF y& < 22
		lyic& = 7
	ELSEIF y& < 25
		lyic& = 8
	ELSEIF y& < 27
		lyic& = 9
	ELSE
		lyic& = 10
	ENDIF

	a& = icdn&:(day&, month&)
	a& = a& + (year& - 1) * 354
	a& = a& + INT(year& / 30) * 11
	a& = a& + lyic& + 227014
	RETURN a&
ENDP


REM ***************************************************************************
REM (defun islamic-calendar-leap-year-p (year)
REM   "Returns t if YEAR is a leap year on the Islamic calendar."
REM   (memq (% year 30)
REM         (list 2 5 7 10 13 16 18 21 24 26 29)))
PROC iclyp:(year&)
    LOCAL x&
    x& = mod&:(year&, INT(30))
    RETURN x&=2 OR x&=5 OR x&=7 OR x&=10 OR x&=13 OR x&=16 OR x&=18 OR x&=21 OR x&=24 OR x&=26 OR x&=29
   
ENDP

REM ***************************************************************************
REM (defun islamic-calendar-last-day-of-month (month year)
REM   "The last day in MONTH during YEAR on the Islamic calendar."
REM   (cond
REM    ((memq month (list 1 3 5 7 9 11)) 30)
REM    ((memq month (list 2 4 6 8 10)) 29)
REM    (t (if (islamic-calendar-leap-year-p year) 30 29))))
PROC icldom&:(month&, year&)
    IF month&=1 OR month&=3 OR month&=5 OR month&=7 OR month&=9 OR month&=11
    	RETURN 30
    ENDIF
    IF month&=2 OR month&=4 OR month&=6 OR month&=8 OR month&=10
    	RETURN 29
    ENDIF
    IF iclyp:(year&)
    	RETURN 30
    ELSE
    	RETURN 29
    ENDIF
ENDP

REM ***************************************************************************
REM 
REM (defun calendar-islamic-from-absolute (date)
REM   "Compute the Islamic date (month day year) corresponding to absolute DATE.
REM The absolute date is the number of days elapsed since the (imaginary)
REM Gregorian date Sunday, December 31, 1 BC."
REM   (if (< date 227015)
REM       (list 0 0 0);; pre-Islamic date
REM     (let* ((approx (/ (- date 227014) 355));; Approximation from below.
REM            (year           ;; Search forward from the approximation.
REM             (+ approx
REM                (calendar-sum y approx
REM                              (>= date (calendar-absolute-from-islamic
REM                                        (list 1 1 (1+ y))))
REM                              1)))
REM            (month          ;; Search forward from Muharram.
REM             (1+ (calendar-sum m 1
REM                               (> date
REM                                  (calendar-absolute-from-islamic
REM                                   (list m
REM                                         (islamic-calendar-last-day-of-month
REM                                          m year)
REM                                         year)))
REM                               1)))
REM            (day            ;; Calculate the day by subtraction.
REM             (- date
REM                (1- (calendar-absolute-from-islamic (list month 1 year))))))
REM       (list month day year))))
PROC islabs$:(date&)
    LOCAL   approx&, year&, month&, day&, sum&, y&, m&
    LOCAL   isl$(8) 	REM yyyymmdd

    approx& = (date& - 227014) / 355

    y& = approx&
    sum& = 0
    WHILE date& >= absisl&:(INT(1), INT(1), INT(y& + 1))
    	sum& = sum& + 1
    	y& = y& + 1
    ENDWH
    year& = approx& + sum&

    m& = 1
    sum& = 0
    WHILE date& > absisl&:(icldom&:(m&, year&), m&, year&)
    	sum& = sum& + 1
    	m& = m& + 1
    ENDWH
    month& = 1 + sum&

    day& = date& - (absisl&:(INT(1), month&, year&) - 1)

    isl$ = NUM$(year&, 4) + RIGHT$("00"+NUM$(month&, 2), 2)
    isl$ = isl$ + RIGHT$("00"+NUM$(day&, 2), 2)

    RETURN isl$
ENDP

REM ===========================================================================
REM
REM End of functions derived from calendar.el
REM
REM ===========================================================================

REM ===========================================================================
REM
REM  The functions in this section are derived from functions in holidays.el in emacs.
REM  Holidays.el is Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
REM  Author: Edward M. Reingold <reingold@cs.uiuc.edu>
REM
REM ===========================================================================

REM   (let* ((century (1+ (/ displayed-year 100)))
REM          (shifted-epact        ;; Age of moon for April 5...
REM           (% (+ 14 (* 11 (% displayed-year 19));;     ...by Nicaean rule
REM                 (-           ;; ...corrected for the Gregorian century rule
REM                  (/ (* 3 century) 4))
REM                 (/    ;; ...corrected for Metonic cycle inaccuracy.
REM                  (+ 5 (* 8 century)) 25)
REM                 (* 30 century));;              Keeps value positive.
REM              30))
REM          (adjusted-epact       ;;  Adjust for 29.5 day month.
REM           (if (or (= shifted-epact 0)
REM                   (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
REM               (1+ shifted-epact)
REM             shifted-epact))
REM          (paschal-moon       ;; Day after the full moon on or after March 21.
REM           (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
REM              adjusted-epact))
REM          (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
REM          (mandatory
REM           (list
REM            (list (calendar-gregorian-from-absolute abs-easter)
REM                  "Easter Sunday")

REM  Calculate the absolute date for easter sunday
PROC easter&:(year&)
	LOCAL	century&
	LOCAL	shepact&	REM shifted-epact; age of moon for April 5
	LOCAL	adepact&	REM adjusted-epact; adjustfor 29.5 day month
	LOCAL	pasmoon&	REM pascal-moon; day of full moon on or after March 21
	LOCAL	abseast&

	century& = year& / 100 + 1

	REM  Age of moon for April 5...
	REM  ...by Nicaean rule
	shepact& = 14 + (11 * mod&:(year&, INT(19)))
	REM  ...corrected for the Gregorian century rule
	shepact& = shepact& - 3*century&/4
	REM  ...corrected for Metonic cycle inaccuracy.
	shepact& = shepact& + (5 + 8*century&)/25
	REM  Keeps value positive.
	shepact& = shepact& + 30*century&
	shepact& = mod&:(shepact&, INT(30))

	REM  Adjust for 29.5 day month.
	IF (shepact&=0) OR ((shepact&=1) AND (mod&:(year&,INT(19)) < 10))
		adepact& = shepact& + 1
	ELSE
		adepact& = shepact&
	ENDIF

	REM  Day after the full moon on or after March 21.
	pasmoon& = absgreg&:(INT(19), INT(4), year&) - adepact&

	abseast& = doob&:(INT(0), INT(pasmoon&+7))

	RETURN abseast&

ENDP

REM =======================================================================================
REM
REM End of functions derived from holidays.el
REM
REM =======================================================================================